Theory CZH_UCAT_Introduction
section‹Introduction›
theory CZH_UCAT_Introduction
imports CZH_Elementary_Categories.CZH_ECAT_Introduction
begin
text‹
This article provides a formalization of further elements of the
theory of 1-categories without an additional structure.
More specifically, this article explores canonical universal
constructions \cite{noauthor_nlab_nodate}\footnote{
\url{https://ncatlab.org/nlab/show/universal+construction}
} and their properties.
›
text‹\newpage›
end
Theory CZH_UCAT_Universal
section‹Universal arrow›
theory CZH_UCAT_Universal
imports
CZH_UCAT_Introduction
CZH_Elementary_Categories.CZH_ECAT_FUNCT
CZH_Elementary_Categories.CZH_ECAT_Set
CZH_Elementary_Categories.CZH_ECAT_Hom
begin
subsection‹Background›
text‹
The following section is based, primarily, on the elements of the content
of Chapter III-1 in \cite{mac_lane_categories_2010}.
›
subsection‹Universal map›
text‹
The universal map is a convenience utility that allows treating
a part of the definition of the universal arrow as an arrow in the
category ‹Set›.
›
subsubsection‹Definition and elementary properties›
definition umap_of :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "umap_of 𝔉 c r u d =
[
(λf'∈⇩∘Hom (𝔉⦇HomDom⦈) r d. 𝔉⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘𝔉⦇HomCod⦈⇙ u),
Hom (𝔉⦇HomDom⦈) r d,
Hom (𝔉⦇HomCod⦈) c (𝔉⦇ObjMap⦈⦇d⦈)
]⇩∘"
definition umap_fo :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "umap_fo 𝔉 c r u d = umap_of (op_cf 𝔉) c r u d"
text‹Components.›
lemma (in is_functor) umap_of_components:
assumes "u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
shows "umap_of 𝔉 c r u d⦇ArrVal⦈ = (λf'∈⇩∘Hom 𝔄 r d. 𝔉⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘𝔅⇙ u)"
and "umap_of 𝔉 c r u d⦇ArrDom⦈ = Hom 𝔄 r d"
and "umap_of 𝔉 c r u d⦇ArrCod⦈ = Hom 𝔅 c (𝔉⦇ObjMap⦈⦇d⦈)"
unfolding umap_of_def arr_field_simps
by (simp_all add: cat_cs_simps nat_omega_simps)
lemma (in is_functor) umap_fo_components:
assumes "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ c"
shows "umap_fo 𝔉 c r u d⦇ArrVal⦈ = (λf'∈⇩∘Hom 𝔄 d r. u ∘⇩A⇘𝔅⇙ 𝔉⦇ArrMap⦈⦇f'⦈)"
and "umap_fo 𝔉 c r u d⦇ArrDom⦈ = Hom 𝔄 d r"
and "umap_fo 𝔉 c r u d⦇ArrCod⦈ = Hom 𝔅 (𝔉⦇ObjMap⦈⦇d⦈) c"
unfolding
umap_fo_def
is_functor.umap_of_components[
OF is_functor_op, unfolded cat_op_simps, OF assms
]
proof(rule vsv_eqI)
fix f' assume "f' ∈⇩∘ 𝒟⇩∘ (λf'∈⇩∘Hom 𝔄 d r. 𝔉⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘op_cat 𝔅⇙ u)"
then have f': "f' : d ↦⇘𝔄⇙ r" by simp
then have 𝔉f': "𝔉⦇ArrMap⦈⦇f'⦈ : 𝔉⦇ObjMap⦈⦇d⦈ ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
by (auto intro: cat_cs_intros)
from f' show
"(λf'∈⇩∘Hom 𝔄 d r. 𝔉⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘op_cat 𝔅⇙ u)⦇f'⦈ =
(λf'∈⇩∘Hom 𝔄 d r. u ∘⇩A⇘𝔅⇙ 𝔉⦇ArrMap⦈⦇f'⦈)⦇f'⦈"
by (simp add: HomCod.op_cat_Comp[OF assms 𝔉f'])
qed simp_all
text‹Universal maps for the opposite functor.›
lemma (in is_functor) op_umap_of[cat_op_simps]: "umap_of (op_cf 𝔉) = umap_fo 𝔉"
unfolding umap_fo_def by simp
lemma (in is_functor) op_umap_fo[cat_op_simps]: "umap_fo (op_cf 𝔉) = umap_of 𝔉"
unfolding umap_fo_def by (simp add: cat_op_simps)
lemmas [cat_op_simps] =
is_functor.op_umap_of
is_functor.op_umap_fo
subsubsection‹Arrow value›
lemma umap_of_ArrVal_vsv[cat_cs_intros]: "vsv (umap_of 𝔉 c r u d⦇ArrVal⦈)"
unfolding umap_of_def arr_field_simps by (simp add: nat_omega_simps)
lemma umap_fo_ArrVal_vsv[cat_cs_intros]: "vsv (umap_fo 𝔉 c r u d⦇ArrVal⦈)"
unfolding umap_fo_def by (rule umap_of_ArrVal_vsv)
lemma (in is_functor) umap_of_ArrVal_vdomain:
assumes "u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
shows "𝒟⇩∘ (umap_of 𝔉 c r u d⦇ArrVal⦈) = Hom 𝔄 r d"
unfolding umap_of_components[OF assms] by simp
lemmas [cat_cs_simps] = is_functor.umap_of_ArrVal_vdomain
lemma (in is_functor) umap_fo_ArrVal_vdomain:
assumes "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ c"
shows "𝒟⇩∘ (umap_fo 𝔉 c r u d⦇ArrVal⦈) = Hom 𝔄 d r"
unfolding umap_fo_components[OF assms] by simp
lemmas [cat_cs_simps] = is_functor.umap_fo_ArrVal_vdomain
lemma (in is_functor) umap_of_ArrVal_app:
assumes "f' : r ↦⇘𝔄⇙ d" and "u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
shows "umap_of 𝔉 c r u d⦇ArrVal⦈⦇f'⦈ = 𝔉⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘𝔅⇙ u"
using assms(1) unfolding umap_of_components[OF assms(2)] by simp
lemmas [cat_cs_simps] = is_functor.umap_of_ArrVal_app
lemma (in is_functor) umap_fo_ArrVal_app:
assumes "f' : d ↦⇘𝔄⇙ r" and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ c"
shows "umap_fo 𝔉 c r u d⦇ArrVal⦈⦇f'⦈ = u ∘⇩A⇘𝔅⇙ 𝔉⦇ArrMap⦈⦇f'⦈"
proof-
from assms have "𝔉⦇ArrMap⦈⦇f'⦈ : 𝔉⦇ObjMap⦈⦇d⦈ ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
by (auto intro: cat_cs_intros)
from this assms(2) have 𝔉f'[simp]:
"𝔉⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘op_cat 𝔅⇙ u = u ∘⇩A⇘𝔅⇙ 𝔉⦇ArrMap⦈⦇f'⦈"
by (simp add: cat_op_simps)
from
is_functor_axioms
is_functor.umap_of_ArrVal_app[
OF is_functor_op, unfolded cat_op_simps,
OF assms
]
show ?thesis
by (simp add: cat_op_simps cat_cs_simps)
qed
lemmas [cat_cs_simps] = is_functor.umap_fo_ArrVal_app
lemma (in is_functor) umap_of_ArrVal_vrange:
assumes "u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
shows "ℛ⇩∘ (umap_of 𝔉 c r u d⦇ArrVal⦈) ⊆⇩∘ Hom 𝔅 c (𝔉⦇ObjMap⦈⦇d⦈)"
proof(intro vsubset_antisym vsubsetI)
interpret vsv ‹umap_of 𝔉 c r u d⦇ArrVal⦈›
unfolding umap_of_components[OF assms] by simp
fix g assume "g ∈⇩∘ ℛ⇩∘ (umap_of 𝔉 c r u d⦇ArrVal⦈)"
then obtain f'
where g_def: "g = umap_of 𝔉 c r u d⦇ArrVal⦈⦇f'⦈"
and f': "f' ∈⇩∘ 𝒟⇩∘ (umap_of 𝔉 c r u d⦇ArrVal⦈)"
unfolding umap_of_components[OF assms] by auto
then have f': "f' : r ↦⇘𝔄⇙ d"
unfolding umap_of_ArrVal_vdomain[OF assms] by simp
then have 𝔉f': "𝔉⦇ArrMap⦈⦇f'⦈ : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇d⦈"
by (auto intro!: cat_cs_intros)
have g_def: "g = 𝔉⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘𝔅⇙ u"
unfolding g_def umap_of_ArrVal_app[OF f' assms]..
from 𝔉f' assms show "g ∈⇩∘ Hom 𝔅 c (𝔉⦇ObjMap⦈⦇d⦈)"
unfolding g_def by (auto intro: cat_cs_intros)
qed
lemma (in is_functor) umap_fo_ArrVal_vrange:
assumes "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ c"
shows "ℛ⇩∘ (umap_fo 𝔉 c r u d⦇ArrVal⦈) ⊆⇩∘ Hom 𝔅 (𝔉⦇ObjMap⦈⦇d⦈) c"
by
(
rule is_functor.umap_of_ArrVal_vrange[
OF is_functor_op, unfolded cat_op_simps, OF assms, folded umap_fo_def
]
)
subsubsection‹Universal map is an arrow in the category ‹Set››
lemma (in is_functor) cf_arr_Set_umap_of:
assumes "category α 𝔄"
and "category α 𝔅"
and r: "r ∈⇩∘ 𝔄⦇Obj⦈"
and d: "d ∈⇩∘ 𝔄⦇Obj⦈"
and u: "u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
shows "arr_Set α (umap_of 𝔉 c r u d)"
proof(intro arr_SetI)
interpret HomDom: category α 𝔄 by (rule assms(1))
interpret HomCod: category α 𝔅 by (rule assms(2))
note umap_of_components = umap_of_components[OF u]
from u d have c: "c ∈⇩∘ 𝔅⦇Obj⦈" and 𝔉d: "(𝔉⦇ObjMap⦈⦇d⦈) ∈⇩∘ 𝔅⦇Obj⦈"
by (auto intro: cat_cs_intros)
show "vfsequence (umap_of 𝔉 c r u d)" unfolding umap_of_def by simp
show "vcard (umap_of 𝔉 c r u d) = 3⇩ℕ"
unfolding umap_of_def by (simp add: nat_omega_simps)
from umap_of_ArrVal_vrange[OF u] show
"ℛ⇩∘ (umap_of 𝔉 c r u d⦇ArrVal⦈) ⊆⇩∘ umap_of 𝔉 c r u d⦇ArrCod⦈"
unfolding umap_of_components by simp
from r d show "umap_of 𝔉 c r u d⦇ArrDom⦈ ∈⇩∘ Vset α"
unfolding umap_of_components by (intro HomDom.cat_Hom_in_Vset)
from c 𝔉d show "umap_of 𝔉 c r u d⦇ArrCod⦈ ∈⇩∘ Vset α"
unfolding umap_of_components by (intro HomCod.cat_Hom_in_Vset)
qed (auto simp: umap_of_components[OF u])
lemma (in is_functor) cf_arr_Set_umap_fo:
assumes "category α 𝔄"
and "category α 𝔅"
and r: "r ∈⇩∘ 𝔄⦇Obj⦈"
and d: "d ∈⇩∘ 𝔄⦇Obj⦈"
and u: "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ c"
shows "arr_Set α (umap_fo 𝔉 c r u d)"
proof-
from assms(1) have 𝔄: "category α (op_cat 𝔄)"
by (auto intro: cat_cs_intros)
from assms(2) have 𝔅: "category α (op_cat 𝔅)"
by (auto intro: cat_cs_intros)
show ?thesis
by
(
rule
is_functor.cf_arr_Set_umap_of[
OF is_functor_op, unfolded cat_op_simps, OF 𝔄 𝔅 r d u
]
)
qed
lemma (in is_functor) cf_umap_of_is_arr:
assumes "category α 𝔄"
and "category α 𝔅"
and "r ∈⇩∘ 𝔄⦇Obj⦈"
and "d ∈⇩∘ 𝔄⦇Obj⦈"
and "u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
shows "umap_of 𝔉 c r u d : Hom 𝔄 r d ↦⇘cat_Set α⇙ Hom 𝔅 c (𝔉⦇ObjMap⦈⦇d⦈)"
proof(intro cat_Set_is_arrI)
show "arr_Set α (umap_of 𝔉 c r u d)"
by (rule cf_arr_Set_umap_of[OF assms])
qed (simp_all add: umap_of_components[OF assms(5)])
lemma (in is_functor) cf_umap_of_is_arr':
assumes "category α 𝔄"
and "category α 𝔅"
and "r ∈⇩∘ 𝔄⦇Obj⦈"
and "d ∈⇩∘ 𝔄⦇Obj⦈"
and "u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
and "A = Hom 𝔄 r d"
and "B = Hom 𝔅 c (𝔉⦇ObjMap⦈⦇d⦈)"
and "ℭ = cat_Set α"
shows "umap_of 𝔉 c r u d : A ↦⇘ℭ⇙ B"
using assms(1-5) unfolding assms(6-8) by (rule cf_umap_of_is_arr)
lemmas [cat_cs_intros] = is_functor.cf_umap_of_is_arr'
lemma (in is_functor) cf_umap_fo_is_arr:
assumes "category α 𝔄"
and "category α 𝔅"
and "r ∈⇩∘ 𝔄⦇Obj⦈"
and "d ∈⇩∘ 𝔄⦇Obj⦈"
and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ c"
shows "umap_fo 𝔉 c r u d : Hom 𝔄 d r ↦⇘cat_Set α⇙ Hom 𝔅 (𝔉⦇ObjMap⦈⦇d⦈) c"
proof(intro cat_Set_is_arrI)
show "arr_Set α (umap_fo 𝔉 c r u d)"
by (rule cf_arr_Set_umap_fo[OF assms])
qed (simp_all add: umap_fo_components[OF assms(5)])
lemma (in is_functor) cf_umap_fo_is_arr':
assumes "category α 𝔄"
and "category α 𝔅"
and "r ∈⇩∘ 𝔄⦇Obj⦈"
and "d ∈⇩∘ 𝔄⦇Obj⦈"
and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ c"
and "A = Hom 𝔄 d r"
and "B = Hom 𝔅 (𝔉⦇ObjMap⦈⦇d⦈) c"
and "ℭ = cat_Set α"
shows "umap_fo 𝔉 c r u d : A ↦⇘ℭ⇙ B"
using assms(1-5) unfolding assms(6-8) by (rule cf_umap_fo_is_arr)
lemmas [cat_cs_intros] = is_functor.cf_umap_fo_is_arr'
subsection‹Universal arrow: definition and elementary properties›
text‹See Chapter III-1 in \cite{mac_lane_categories_2010}.›
definition universal_arrow_of :: "V ⇒ V ⇒ V ⇒ V ⇒ bool"
where "universal_arrow_of 𝔉 c r u ⟷
(
r ∈⇩∘ 𝔉⦇HomDom⦈⦇Obj⦈ ∧
u : c ↦⇘𝔉⦇HomCod⦈⇙ 𝔉⦇ObjMap⦈⦇r⦈ ∧
(
∀r' u'.
r' ∈⇩∘ 𝔉⦇HomDom⦈⦇Obj⦈ ⟶
u' : c ↦⇘𝔉⦇HomCod⦈⇙ 𝔉⦇ObjMap⦈⦇r'⦈ ⟶
(∃!f'. f' : r ↦⇘𝔉⦇HomDom⦈⇙ r' ∧ u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈)
)
)"
definition universal_arrow_fo :: "V ⇒ V ⇒ V ⇒ V ⇒ bool"
where "universal_arrow_fo 𝔉 c r u ≡ universal_arrow_of (op_cf 𝔉) c r u"
text‹Rules.›
mk_ide (in is_functor) rf
universal_arrow_of_def[where 𝔉=𝔉, unfolded cf_HomDom cf_HomCod]
|intro universal_arrow_ofI|
|dest universal_arrow_ofD[dest]|
|elim universal_arrow_ofE[elim]|
lemma (in is_functor) universal_arrow_foI:
assumes "r ∈⇩∘ 𝔄⦇Obj⦈"
and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ c"
and "⋀r' u'. ⟦ r' ∈⇩∘ 𝔄⦇Obj⦈; u' : 𝔉⦇ObjMap⦈⦇r'⦈ ↦⇘𝔅⇙ c ⟧ ⟹
∃!f'. f' : r' ↦⇘𝔄⇙ r ∧ u' = umap_fo 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
shows "universal_arrow_fo 𝔉 c r u"
by
(
simp add:
is_functor.universal_arrow_ofI
[
OF is_functor_op,
folded universal_arrow_fo_def,
unfolded cat_op_simps,
OF assms
]
)
lemma (in is_functor) universal_arrow_foD[dest]:
assumes "universal_arrow_fo 𝔉 c r u"
shows "r ∈⇩∘ 𝔄⦇Obj⦈"
and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ c"
and "⋀r' u'. ⟦ r' ∈⇩∘ 𝔄⦇Obj⦈; u' : 𝔉⦇ObjMap⦈⦇r'⦈ ↦⇘𝔅⇙ c ⟧ ⟹
∃!f'. f' : r' ↦⇘𝔄⇙ r ∧ u' = umap_fo 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
by
(
auto simp:
is_functor.universal_arrow_ofD
[
OF is_functor_op,
folded universal_arrow_fo_def,
unfolded cat_op_simps,
OF assms
]
)
lemma (in is_functor) universal_arrow_foE[elim]:
assumes "universal_arrow_fo 𝔉 c r u"
obtains "r ∈⇩∘ 𝔄⦇Obj⦈"
and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ c"
and "⋀r' u'. ⟦ r' ∈⇩∘ 𝔄⦇Obj⦈; u' : 𝔉⦇ObjMap⦈⦇r'⦈ ↦⇘𝔅⇙ c ⟧ ⟹
∃!f'. f' : r' ↦⇘𝔄⇙ r ∧ u' = umap_fo 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
using assms by (auto simp: universal_arrow_foD)
text‹Elementary properties.›
lemma (in is_functor) op_cf_universal_arrow_of[cat_op_simps]:
"universal_arrow_of (op_cf 𝔉) c r u ⟷ universal_arrow_fo 𝔉 c r u"
unfolding universal_arrow_fo_def ..
lemma (in is_functor) op_cf_universal_arrow_fo[cat_op_simps]:
"universal_arrow_fo (op_cf 𝔉) c r u ⟷ universal_arrow_of 𝔉 c r u"
unfolding universal_arrow_fo_def cat_op_simps ..
lemmas (in is_functor) [cat_op_simps] =
is_functor.op_cf_universal_arrow_of
is_functor.op_cf_universal_arrow_fo
subsection‹Uniqueness›
text‹
The following properties are related to the uniqueness of the
universal arrow. These properties can be inferred from the content of
Chapter III-1 in \cite{mac_lane_categories_2010}.
›
lemma (in is_functor) cf_universal_arrow_of_ex_is_arr_isomorphism:
assumes "universal_arrow_of 𝔉 c r u" and "universal_arrow_of 𝔉 c r' u'"
obtains f where "f : r ↦⇩i⇩s⇩o⇘𝔄⇙ r'" and "u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f⦈"
proof-
note ua1 = universal_arrow_ofD[OF assms(1)]
note ua2 = universal_arrow_ofD[OF assms(2)]
from ua1(1) have 𝔄r: "𝔄⦇CId⦈⦇r⦈ : r ↦⇘𝔄⇙ r" by (auto intro: cat_cs_intros)
from ua1(1) have "𝔉⦇ArrMap⦈⦇𝔄⦇CId⦈⦇r⦈⦈ = 𝔅⦇CId⦈⦇𝔉⦇ObjMap⦈⦇r⦈⦈"
by (auto intro: cat_cs_intros)
with ua1(1,2) have u_def: "u = umap_of 𝔉 c r u r⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
unfolding umap_of_ArrVal_app[OF 𝔄r ua1(2)] by (auto simp: cat_cs_simps)
from ua2(1) have 𝔄r': "𝔄⦇CId⦈⦇r'⦈ : r' ↦⇘𝔄⇙ r'" by (auto intro: cat_cs_intros)
from ua2(1) have "𝔉⦇ArrMap⦈⦇𝔄⦇CId⦈⦇r'⦈⦈ = 𝔅⦇CId⦈⦇𝔉⦇ObjMap⦈⦇r'⦈⦈"
by (auto intro: cat_cs_intros)
with ua2(1,2) have u'_def: "u' = umap_of 𝔉 c r' u' r'⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r'⦈⦈"
unfolding umap_of_ArrVal_app[OF 𝔄r' ua2(2)] by (auto simp: cat_cs_simps)
from 𝔄r u_def universal_arrow_ofD(3)[OF assms(1) ua1(1,2)] have eq_CId_rI:
"⟦ f' : r ↦⇘𝔄⇙ r; u = umap_of 𝔉 c r u r⦇ArrVal⦈⦇f'⦈ ⟧ ⟹ f' = 𝔄⦇CId⦈⦇r⦈"
for f'
by blast
from 𝔄r' u'_def universal_arrow_ofD(3)[OF assms(2) ua2(1,2)] have eq_CId_r'I:
"⟦ f' : r' ↦⇘𝔄⇙ r'; u' = umap_of 𝔉 c r' u' r'⦇ArrVal⦈⦇f'⦈ ⟧ ⟹
f' = 𝔄⦇CId⦈⦇r'⦈"
for f'
by blast
from ua1(3)[OF ua2(1,2)] obtain f
where f: "f : r ↦⇘𝔄⇙ r'"
and u'_def: "u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f⦈"
and "g : r ↦⇘𝔄⇙ r' ⟹ u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇g⦈ ⟹ f = g"
for g
by metis
from ua2(3)[OF ua1(1,2)] obtain f'
where f': "f' : r' ↦⇘𝔄⇙ r"
and u_def: "u = umap_of 𝔉 c r' u' r⦇ArrVal⦈⦇f'⦈"
and "g : r' ↦⇘𝔄⇙ r ⟹ u = umap_of 𝔉 c r' u' r⦇ArrVal⦈⦇g⦈ ⟹ f' = g"
for g
by metis
have "f : r ↦⇩i⇩s⇩o⇘𝔄⇙ r'"
proof(intro is_arr_isomorphismI is_inverseI)
show f: "f : r ↦⇘𝔄⇙ r'" by (rule f)
show f': "f' : r' ↦⇘𝔄⇙ r" by (rule f')
show "f : r ↦⇘𝔄⇙ r'" by (rule f)
from f' have 𝔉f': "𝔉⦇ArrMap⦈⦇f'⦈ : 𝔉⦇ObjMap⦈⦇r'⦈ ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
by (auto intro: cat_cs_intros)
from f have 𝔉f: "𝔉⦇ArrMap⦈⦇f⦈ : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r'⦈"
by (auto intro: cat_cs_intros)
note u'_def' = u'_def[symmetric, unfolded umap_of_ArrVal_app[OF f ua1(2)]]
and u_def' = u_def[symmetric, unfolded umap_of_ArrVal_app[OF f' ua2(2)]]
show "f' ∘⇩A⇘𝔄⇙ f = 𝔄⦇CId⦈⦇r⦈"
proof(rule eq_CId_rI)
from f f' show f'f: "f' ∘⇩A⇘𝔄⇙ f : r ↦⇘𝔄⇙ r"
by (auto intro: cat_cs_intros)
from ua1(2) 𝔉f' 𝔉f show "u = umap_of 𝔉 c r u r⦇ArrVal⦈⦇f' ∘⇩A⇘𝔄⇙ f⦈"
unfolding umap_of_ArrVal_app[OF f'f ua1(2)] cf_ArrMap_Comp[OF f' f]
by (simp add: HomCod.cat_Comp_assoc u'_def' u_def')
qed
show "f ∘⇩A⇘𝔄⇙ f' = 𝔄⦇CId⦈⦇r'⦈"
proof(rule eq_CId_r'I)
from f f' show ff': "f ∘⇩A⇘𝔄⇙ f' : r' ↦⇘𝔄⇙ r'"
by (auto intro: cat_cs_intros)
from ua2(2) 𝔉f' 𝔉f show "u' = umap_of 𝔉 c r' u' r'⦇ArrVal⦈⦇f ∘⇩A⇘𝔄⇙ f'⦈"
unfolding umap_of_ArrVal_app[OF ff' ua2(2)] cf_ArrMap_Comp[OF f f']
by (simp add: HomCod.cat_Comp_assoc u'_def' u_def')
qed
qed
with u'_def that show ?thesis by auto
qed
lemma (in is_functor) cf_universal_arrow_fo_ex_is_arr_isomorphism:
assumes "universal_arrow_fo 𝔉 c r u"
and "universal_arrow_fo 𝔉 c r' u'"
obtains f where "f : r' ↦⇩i⇩s⇩o⇘𝔄⇙ r" and "u' = umap_fo 𝔉 c r u r'⦇ArrVal⦈⦇f⦈"
by
(
elim
is_functor.cf_universal_arrow_of_ex_is_arr_isomorphism[
OF is_functor_op, unfolded cat_op_simps, OF assms
]
)
lemma (in is_functor) cf_universal_arrow_of_unique:
assumes "universal_arrow_of 𝔉 c r u"
and "universal_arrow_of 𝔉 c r' u'"
shows "∃!f'. f' : r ↦⇘𝔄⇙ r' ∧ u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
proof-
note ua1 = universal_arrow_ofD[OF assms(1)]
note ua2 = universal_arrow_ofD[OF assms(2)]
from ua1(3)[OF ua2(1,2)] show ?thesis .
qed
lemma (in is_functor) cf_universal_arrow_fo_unique:
assumes "universal_arrow_fo 𝔉 c r u"
and "universal_arrow_fo 𝔉 c r' u'"
shows "∃!f'. f' : r' ↦⇘𝔄⇙ r ∧ u' = umap_fo 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
proof-
note ua1 = universal_arrow_foD[OF assms(1)]
note ua2 = universal_arrow_foD[OF assms(2)]
from ua1(3)[OF ua2(1,2)] show ?thesis .
qed
lemma (in is_functor) cf_universal_arrow_of_is_arr_isomorphism:
assumes "universal_arrow_of 𝔉 c r u"
and "universal_arrow_of 𝔉 c r' u'"
and "f : r ↦⇘𝔄⇙ r'"
and "u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f⦈"
shows "f : r ↦⇩i⇩s⇩o⇘𝔄⇙ r'"
proof-
from assms(3,4) cf_universal_arrow_of_unique[OF assms(1,2)] have eq:
"g : r ↦⇘𝔄⇙ r' ⟹ u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇g⦈ ⟹ f = g" for g
by blast
from assms(1,2) obtain f'
where iso_f': "f' : r ↦⇩i⇩s⇩o⇘𝔄⇙ r'"
and u'_def: "u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
by (auto elim: cf_universal_arrow_of_ex_is_arr_isomorphism)
then have f': "f' : r ↦⇘𝔄⇙ r'" by auto
from iso_f' show ?thesis unfolding eq[OF f' u'_def, symmetric].
qed
lemma (in is_functor) cf_universal_arrow_fo_is_arr_isomorphism:
assumes "universal_arrow_fo 𝔉 c r u"
and "universal_arrow_fo 𝔉 c r' u'"
and "f : r' ↦⇘𝔄⇙ r"
and "u' = umap_fo 𝔉 c r u r'⦇ArrVal⦈⦇f⦈"
shows "f : r' ↦⇩i⇩s⇩o⇘𝔄⇙ r"
by
(
rule
is_functor.cf_universal_arrow_of_is_arr_isomorphism[
OF is_functor_op, unfolded cat_op_simps, OF assms
]
)
subsection‹Universal natural transformation›
subsubsection‹Definition and elementary properties›
text‹
The concept of the universal natural transformation is introduced for the
statement of the elements of a variant of Proposition 1 in Chapter III-2
in \cite{mac_lane_categories_2010}.
›
definition ntcf_ua_of :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "ntcf_ua_of α 𝔉 c r u =
[
(λd∈⇩∘𝔉⦇HomDom⦈⦇Obj⦈. umap_of 𝔉 c r u d),
Hom⇩O⇩.⇩C⇘α⇙𝔉⦇HomDom⦈(r,-),
Hom⇩O⇩.⇩C⇘α⇙𝔉⦇HomCod⦈(c,-) ∘⇩C⇩F 𝔉,
𝔉⦇HomDom⦈,
cat_Set α
]⇩∘"
definition ntcf_ua_fo :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "ntcf_ua_fo α 𝔉 c r u = ntcf_ua_of α (op_cf 𝔉) c r u"
text‹Components.›
lemma ntcf_ua_of_components:
shows "ntcf_ua_of α 𝔉 c r u⦇NTMap⦈ = (λd∈⇩∘𝔉⦇HomDom⦈⦇Obj⦈. umap_of 𝔉 c r u d)"
and "ntcf_ua_of α 𝔉 c r u⦇NTDom⦈ = Hom⇩O⇩.⇩C⇘α⇙𝔉⦇HomDom⦈(r,-)"
and "ntcf_ua_of α 𝔉 c r u⦇NTCod⦈ = Hom⇩O⇩.⇩C⇘α⇙𝔉⦇HomCod⦈(c,-) ∘⇩C⇩F 𝔉"
and "ntcf_ua_of α 𝔉 c r u⦇NTDGDom⦈ = 𝔉⦇HomDom⦈"
and "ntcf_ua_of α 𝔉 c r u⦇NTDGCod⦈ = cat_Set α"
unfolding ntcf_ua_of_def nt_field_simps by (simp_all add: nat_omega_simps)
lemma ntcf_ua_fo_components:
shows "ntcf_ua_fo α 𝔉 c r u⦇NTMap⦈ = (λd∈⇩∘𝔉⦇HomDom⦈⦇Obj⦈. umap_fo 𝔉 c r u d)"
and "ntcf_ua_fo α 𝔉 c r u⦇NTDom⦈ = Hom⇩O⇩.⇩C⇘α⇙op_cat (𝔉⦇HomDom⦈)(r,-)"
and "ntcf_ua_fo α 𝔉 c r u⦇NTCod⦈ =
Hom⇩O⇩.⇩C⇘α⇙op_cat (𝔉⦇HomCod⦈)(c,-) ∘⇩C⇩F op_cf 𝔉"
and "ntcf_ua_fo α 𝔉 c r u⦇NTDGDom⦈ = op_cat (𝔉⦇HomDom⦈)"
and "ntcf_ua_fo α 𝔉 c r u⦇NTDGCod⦈ = cat_Set α"
unfolding ntcf_ua_fo_def ntcf_ua_of_components umap_fo_def cat_op_simps
by simp_all
context is_functor
begin
lemmas ntcf_ua_of_components' =
ntcf_ua_of_components[where α=α and 𝔉=𝔉, unfolded cat_cs_simps]
lemmas [cat_cs_simps] = ntcf_ua_of_components'(2-5)
lemma ntcf_ua_fo_components':
assumes "c ∈⇩∘ 𝔅⦇Obj⦈" and "r ∈⇩∘ 𝔄⦇Obj⦈"
shows "ntcf_ua_fo α 𝔉 c r u⦇NTMap⦈ = (λd∈⇩∘𝔄⦇Obj⦈. umap_fo 𝔉 c r u d)"
and [cat_cs_simps]:
"ntcf_ua_fo α 𝔉 c r u⦇NTDom⦈ = Hom⇩O⇩.⇩C⇘α⇙𝔄(-,r)"
and [cat_cs_simps]:
"ntcf_ua_fo α 𝔉 c r u⦇NTCod⦈ = Hom⇩O⇩.⇩C⇘α⇙𝔅(-,c) ∘⇩C⇩F op_cf 𝔉"
and [cat_cs_simps]: "ntcf_ua_fo α 𝔉 c r u⦇NTDGDom⦈ = op_cat 𝔄"
and [cat_cs_simps]: "ntcf_ua_fo α 𝔉 c r u⦇NTDGCod⦈ = cat_Set α"
unfolding
ntcf_ua_fo_components cat_cs_simps
HomDom.cat_op_cat_cf_Hom_snd[OF assms(2)]
HomCod.cat_op_cat_cf_Hom_snd[OF assms(1)]
by simp_all
end
lemmas [cat_cs_simps] =
is_functor.ntcf_ua_of_components'(2-5)
is_functor.ntcf_ua_fo_components'(2-5)
subsubsection‹Natural transformation map›
mk_VLambda (in is_functor)
ntcf_ua_of_components(1)[where α=α and 𝔉=𝔉, unfolded cf_HomDom]
|vsv ntcf_ua_of_NTMap_vsv|
|vdomain ntcf_ua_of_NTMap_vdomain|
|app ntcf_ua_of_NTMap_app|
context is_functor
begin
context
fixes c r
assumes r: "r ∈⇩∘ 𝔄⦇Obj⦈" and c: "c ∈⇩∘ 𝔅⦇Obj⦈"
begin
mk_VLambda ntcf_ua_fo_components'(1)[OF c r]
|vsv ntcf_ua_fo_NTMap_vsv|
|vdomain ntcf_ua_fo_NTMap_vdomain|
|app ntcf_ua_fo_NTMap_app|
end
end
lemmas [cat_cs_intros] =
is_functor.ntcf_ua_fo_NTMap_vsv
is_functor.ntcf_ua_of_NTMap_vsv
lemmas [cat_cs_simps] =
is_functor.ntcf_ua_fo_NTMap_vdomain
is_functor.ntcf_ua_fo_NTMap_app
is_functor.ntcf_ua_of_NTMap_vdomain
is_functor.ntcf_ua_of_NTMap_app
lemma (in is_functor) ntcf_ua_of_NTMap_vrange:
assumes "category α 𝔄"
and "category α 𝔅"
and "r ∈⇩∘ 𝔄⦇Obj⦈"
and "u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
shows "ℛ⇩∘ (ntcf_ua_of α 𝔉 c r u⦇NTMap⦈) ⊆⇩∘ cat_Set α⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold ntcf_ua_of_NTMap_vdomain)
show "vsv (ntcf_ua_of α 𝔉 c r u⦇NTMap⦈)" by (rule ntcf_ua_of_NTMap_vsv)
fix d assume prems: "d ∈⇩∘ 𝔄⦇Obj⦈"
with category_cat_Set is_functor_axioms assms show
"ntcf_ua_of α 𝔉 c r u⦇NTMap⦈⦇d⦈ ∈⇩∘ cat_Set α⦇Arr⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
subsubsection‹Commutativity of the universal maps and ‹hom›-functions›
lemma (in is_functor) cf_umap_of_cf_hom_commute:
assumes "category α 𝔄"
and "category α 𝔅"
and "c ∈⇩∘ 𝔅⦇Obj⦈"
and "r ∈⇩∘ 𝔄⦇Obj⦈"
and "u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
and "f : a ↦⇘𝔄⇙ b"
shows
"umap_of 𝔉 c r u b ∘⇩A⇘cat_Set α⇙ cf_hom 𝔄 [𝔄⦇CId⦈⦇r⦈, f]⇩∘ =
cf_hom 𝔅 [𝔅⦇CId⦈⦇c⦈, 𝔉⦇ArrMap⦈⦇f⦈]⇩∘ ∘⇩A⇘cat_Set α⇙ umap_of 𝔉 c r u a"
(is ‹?uof_b ∘⇩A⇘cat_Set α⇙ ?rf = ?cf ∘⇩A⇘cat_Set α⇙ ?uof_a›)
proof-
from is_functor_axioms category_cat_Set assms(1,2,4-6) have b_rf:
"?uof_b ∘⇩A⇘cat_Set α⇙ ?rf : Hom 𝔄 r a ↦⇘cat_Set α⇙ Hom 𝔅 c (𝔉⦇ObjMap⦈⦇b⦈)"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
from is_functor_axioms category_cat_Set assms(1,2,4-6) have cf_a:
"?cf ∘⇩A⇘cat_Set α⇙ ?uof_a : Hom 𝔄 r a ↦⇘cat_Set α⇙ Hom 𝔅 c (𝔉⦇ObjMap⦈⦇b⦈)"
by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
show ?thesis
proof(rule arr_Set_eqI[of α])
from b_rf show arr_Set_b_rf: "arr_Set α (?uof_b ∘⇩A⇘cat_Set α⇙ ?rf)"
by (auto dest: cat_Set_is_arrD(1))
from b_rf have dom_lhs:
"𝒟⇩∘ ((?uof_b ∘⇩A⇘cat_Set α⇙ ?rf)⦇ArrVal⦈) = Hom 𝔄 r a"
by (cs_concl cs_simp: cat_cs_simps)+
from cf_a show arr_Set_cf_a: "arr_Set α (?cf ∘⇩A⇘cat_Set α⇙ ?uof_a)"
by (auto dest: cat_Set_is_arrD(1))
from cf_a have dom_rhs:
"𝒟⇩∘ ((?cf ∘⇩A⇘cat_Set α⇙ ?uof_a)⦇ArrVal⦈) = Hom 𝔄 r a"
by (cs_concl cs_simp: cat_cs_simps)
show "(?uof_b ∘⇩A⇘cat_Set α⇙ ?rf)⦇ArrVal⦈ = (?cf ∘⇩A⇘cat_Set α⇙ ?uof_a)⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix q assume "q : r ↦⇘𝔄⇙ a"
with is_functor_axioms category_cat_Set assms show
"(?uof_b ∘⇩A⇘cat_Set α⇙ ?rf)⦇ArrVal⦈⦇q⦈ =
(?cf ∘⇩A⇘cat_Set α⇙ ?uof_a)⦇ArrVal⦈⦇q⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed (use arr_Set_b_rf arr_Set_cf_a in auto)
qed (use b_rf cf_a in ‹cs_concl cs_simp: cat_cs_simps›)+
qed
lemma cf_umap_of_cf_hom_unit_commute:
assumes "category α ℭ"
and "category α 𝔇"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "η : cf_id ℭ ↦⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
and "g : c' ↦⇘ℭ⇙ c"
and "f : d ↦⇘𝔇⇙ d'"
shows
"umap_of 𝔊 c' (𝔉⦇ObjMap⦈⦇c'⦈) (η⦇NTMap⦈⦇c'⦈) d' ∘⇩A⇘cat_Set α⇙
cf_hom 𝔇 [𝔉⦇ArrMap⦈⦇g⦈, f]⇩∘ =
cf_hom ℭ [g, 𝔊⦇ArrMap⦈⦇f⦈]⇩∘ ∘⇩A⇘cat_Set α⇙
umap_of 𝔊 c (𝔉⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈) d"
(is ‹?uof_c'd' ∘⇩A⇘cat_Set α⇙ ?𝔉gf = ?g𝔊f ∘⇩A⇘cat_Set α⇙ ?uof_cd›)
proof-
interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘⇩C⇩F 𝔉› η by (rule assms(5))
from assms have c'd'_𝔉gf: "?uof_c'd' ∘⇩A⇘cat_Set α⇙ ?𝔉gf :
Hom 𝔇 (𝔉⦇ObjMap⦈⦇c⦈) d ↦⇘cat_Set α⇙ Hom ℭ c' (𝔊⦇ObjMap⦈⦇d'⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
then have dom_lhs:
"𝒟⇩∘ ((?uof_c'd' ∘⇩A⇘cat_Set α⇙ ?𝔉gf)⦇ArrVal⦈) = Hom 𝔇 (𝔉⦇ObjMap⦈⦇c⦈) d"
by (cs_concl cs_simp: cat_cs_simps)
from assms have g𝔊f_cd: "?g𝔊f ∘⇩A⇘cat_Set α⇙ ?uof_cd :
Hom 𝔇 (𝔉⦇ObjMap⦈⦇c⦈) d ↦⇘cat_Set α⇙ Hom ℭ c' (𝔊⦇ObjMap⦈⦇d'⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
then have dom_rhs:
"𝒟⇩∘ ((?g𝔊f ∘⇩A⇘cat_Set α⇙ ?uof_cd)⦇ArrVal⦈) = Hom 𝔇 (𝔉⦇ObjMap⦈⦇c⦈) d"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of α])
from c'd'_𝔉gf show arr_Set_c'd'_𝔉gf:
"arr_Set α (?uof_c'd' ∘⇩A⇘cat_Set α⇙ ?𝔉gf)"
by (auto dest: cat_Set_is_arrD(1))
from g𝔊f_cd show arr_Set_g𝔊f_cd:
"arr_Set α (?g𝔊f ∘⇩A⇘cat_Set α⇙ ?uof_cd)"
by (auto dest: cat_Set_is_arrD(1))
show
"(?uof_c'd' ∘⇩A⇘cat_Set α⇙ ?𝔉gf)⦇ArrVal⦈ =
(?g𝔊f ∘⇩A⇘cat_Set α⇙ ?uof_cd)⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix h assume prems: "h : 𝔉⦇ObjMap⦈⦇c⦈ ↦⇘𝔇⇙ d"
from η.ntcf_Comp_commute[OF assms(6)] assms have [cat_cs_simps]:
"η⦇NTMap⦈⦇c⦈ ∘⇩A⇘ℭ⇙ g = 𝔊⦇ArrMap⦈⦇𝔉⦇ArrMap⦈⦇g⦈⦈ ∘⇩A⇘ℭ⇙ η⦇NTMap⦈⦇c'⦈"
by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
from assms prems show
"(?uof_c'd' ∘⇩A⇘cat_Set α⇙ ?𝔉gf)⦇ArrVal⦈⦇h⦈ =
(?g𝔊f ∘⇩A⇘cat_Set α⇙ ?uof_cd)⦇ArrVal⦈⦇h⦈"
by
(
cs_concl
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
cs_simp: cat_cs_simps
)
qed (use arr_Set_c'd'_𝔉gf arr_Set_g𝔊f_cd in auto)
qed (use c'd'_𝔉gf g𝔊f_cd in ‹cs_concl cs_simp: cat_cs_simps›)+
qed
subsubsection‹Universal natural transformation is a natural transformation›
lemma (in is_functor) cf_ntcf_ua_of_is_ntcf:
assumes "r ∈⇩∘ 𝔄⦇Obj⦈"
and "u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
shows "ntcf_ua_of α 𝔉 c r u :
Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉 : 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
proof(intro is_ntcfI')
let ?ua = ‹ntcf_ua_of α 𝔉 c r u›
show "vfsequence (ntcf_ua_of α 𝔉 c r u)" unfolding ntcf_ua_of_def by simp
show "vcard ?ua = 5⇩ℕ" unfolding ntcf_ua_of_def by (simp add: nat_omega_simps)
from assms(1) show "Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-) : 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_intro: cat_cs_intros)
from is_functor_axioms assms(2) show
"Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉 : 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_intro: cat_cs_intros)
from is_functor_axioms assms show "𝒟⇩∘ (?ua⦇NTMap⦈) = 𝔄⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
show "?ua⦇NTMap⦈⦇a⦈ :
Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-)⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set α⇙ (Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉)⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ 𝔄⦇Obj⦈" for a
using is_functor_axioms assms that
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
show "?ua⦇NTMap⦈⦇b⦈ ∘⇩A⇘cat_Set α⇙ Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-)⦇ArrMap⦈⦇f⦈ =
(Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉)⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ ?ua⦇NTMap⦈⦇a⦈"
if "f : a ↦⇘𝔄⇙ b" for a b f
using is_functor_axioms assms that
by
(
cs_concl
cs_simp: cf_umap_of_cf_hom_commute cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed (auto simp: ntcf_ua_of_components cat_cs_simps)
lemma (in is_functor) cf_ntcf_ua_fo_is_ntcf:
assumes "r ∈⇩∘ 𝔄⦇Obj⦈" and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ c"
shows "ntcf_ua_fo α 𝔉 c r u :
Hom⇩O⇩.⇩C⇘α⇙𝔄(-,r) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔅(-,c) ∘⇩C⇩F op_cf 𝔉 :
op_cat 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
proof-
from assms(2) have c: "c ∈⇩∘ 𝔅⦇Obj⦈" by auto
show ?thesis
by
(
rule is_functor.cf_ntcf_ua_of_is_ntcf
[
OF is_functor_op,
unfolded cat_op_simps,
OF assms(1,2),
unfolded
HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)]
HomCod.cat_op_cat_cf_Hom_snd[OF c]
ntcf_ua_fo_def[symmetric]
]
)
qed
subsubsection‹Universal natural transformation and universal arrow›
text‹
The lemmas in this subsection correspond to
variants of elements of Proposition 1 in Chapter III-2 in
\cite{mac_lane_categories_2010}.
›
lemma (in is_functor) cf_ntcf_ua_of_is_iso_ntcf:
assumes "universal_arrow_of 𝔉 c r u"
shows "ntcf_ua_of α 𝔉 c r u :
Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉 : 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
proof-
have r: "r ∈⇩∘ 𝔄⦇Obj⦈"
and u: "u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
and bij: "⋀r' u'.
⟦
r' ∈⇩∘ 𝔄⦇Obj⦈;
u' : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r'⦈
⟧ ⟹ ∃!f'. f' : r ↦⇘𝔄⇙ r' ∧ u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
by (auto intro!: universal_arrow_ofD[OF assms(1)])
show ?thesis
proof(intro is_iso_ntcfI)
show "ntcf_ua_of α 𝔉 c r u :
Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉 : 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
by (rule cf_ntcf_ua_of_is_ntcf[OF r u])
fix a assume prems: "a ∈⇩∘ 𝔄⦇Obj⦈"
from is_functor_axioms prems r u have [simp]:
"umap_of 𝔉 c r u a : Hom 𝔄 r a ↦⇘cat_Set α⇙ Hom 𝔅 c (𝔉⦇ObjMap⦈⦇a⦈)"
by (cs_concl cs_intro: cat_cs_intros)
then have dom: "𝒟⇩∘ (umap_of 𝔉 c r u a⦇ArrVal⦈) = Hom 𝔄 r a"
by (cs_concl cs_simp: cat_cs_simps)
have "umap_of 𝔉 c r u a : Hom 𝔄 r a ↦⇩i⇩s⇩o⇘cat_Set α⇙ Hom 𝔅 c (𝔉⦇ObjMap⦈⦇a⦈)"
proof(intro cat_Set_is_arr_isomorphismI, unfold dom)
show umof_a: "v11 (umap_of 𝔉 c r u a⦇ArrVal⦈)"
proof(intro vsv.vsv_valeq_v11I, unfold dom in_Hom_iff)
fix g f assume prems':
"g : r ↦⇘𝔄⇙ a"
"f : r ↦⇘𝔄⇙ a"
"umap_of 𝔉 c r u a⦇ArrVal⦈⦇g⦈ = umap_of 𝔉 c r u a⦇ArrVal⦈⦇f⦈"
from is_functor_axioms r u prems'(1) have 𝔉g:
"𝔉⦇ArrMap⦈⦇g⦈ ∘⇩A⇘𝔅⇙ u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇a⦈"
by (cs_concl cs_intro: cat_cs_intros)
from bij[OF prems 𝔉g] have unique:
"⟦
f' : r ↦⇘𝔄⇙ a;
𝔉⦇ArrMap⦈⦇g⦈ ∘⇩A⇘𝔅⇙ u = umap_of 𝔉 c r u a⦇ArrVal⦈⦇f'⦈
⟧ ⟹ g = f'"
for f' by (metis prems'(1) u umap_of_ArrVal_app)
from is_functor_axioms prems'(1,2) u have 𝔉g_u:
"𝔉⦇ArrMap⦈⦇g⦈ ∘⇩A⇘𝔅⇙ u = umap_of 𝔉 c r u a⦇ArrVal⦈⦇f⦈"
by (cs_concl cs_simp: prems'(3)[symmetric] cat_cs_simps)
show "g = f" by (rule unique[OF prems'(2) 𝔉g_u])
qed (auto simp: cat_cs_simps cat_cs_intros)
interpret umof_a: v11 ‹umap_of 𝔉 c r u a⦇ArrVal⦈› by (rule umof_a)
show "ℛ⇩∘ (umap_of 𝔉 c r u a⦇ArrVal⦈) = Hom 𝔅 c (𝔉⦇ObjMap⦈⦇a⦈)"
proof(intro vsubset_antisym)
from u show "ℛ⇩∘ (umap_of 𝔉 c r u a⦇ArrVal⦈) ⊆⇩∘ Hom 𝔅 c (𝔉⦇ObjMap⦈⦇a⦈)"
by (rule umap_of_ArrVal_vrange)
show "Hom 𝔅 c (𝔉⦇ObjMap⦈⦇a⦈) ⊆⇩∘ ℛ⇩∘ (umap_of 𝔉 c r u a⦇ArrVal⦈)"
proof(rule vsubsetI, unfold in_Hom_iff )
fix f assume prems': "f : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇a⦈"
from bij[OF prems prems'] obtain f'
where f': "f' : r ↦⇘𝔄⇙ a"
and f_def: "f = umap_of 𝔉 c r u a⦇ArrVal⦈⦇f'⦈"
by auto
from is_functor_axioms prems prems' u f' have
"f' ∈⇩∘ 𝒟⇩∘ (umap_of 𝔉 c r u a⦇ArrVal⦈)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from this show "f ∈⇩∘ ℛ⇩∘ (umap_of 𝔉 c r u a⦇ArrVal⦈)"
unfolding f_def by (rule umof_a.vsv_vimageI2)
qed
qed
qed simp_all
from is_functor_axioms prems r u this show
"ntcf_ua_of α 𝔉 c r u⦇NTMap⦈⦇a⦈ :
Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-)⦇ObjMap⦈⦇a⦈ ↦⇩i⇩s⇩o⇘cat_Set α⇙
(Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉)⦇ObjMap⦈⦇a⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed
qed
lemmas [cat_cs_intros] = is_functor.cf_ntcf_ua_of_is_iso_ntcf
lemma (in is_functor) cf_ntcf_ua_fo_is_iso_ntcf:
assumes "universal_arrow_fo 𝔉 c r u"
shows "ntcf_ua_fo α 𝔉 c r u :
Hom⇩O⇩.⇩C⇘α⇙𝔄(-,r) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙𝔅(-,c) ∘⇩C⇩F op_cf 𝔉 :
op_cat 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
proof-
from universal_arrow_foD[OF assms] have r: "r ∈⇩∘ 𝔄⦇Obj⦈" and c: "c ∈⇩∘ 𝔅⦇Obj⦈"
by auto
show ?thesis
by
(
rule is_functor.cf_ntcf_ua_of_is_iso_ntcf
[
OF is_functor_op,
unfolded cat_op_simps,
OF assms,
unfolded
HomDom.cat_op_cat_cf_Hom_snd[OF r]
HomCod.cat_op_cat_cf_Hom_snd[OF c]
ntcf_ua_fo_def[symmetric]
]
)
qed
lemmas [cat_cs_intros] = is_functor.cf_ntcf_ua_fo_is_iso_ntcf
lemma (in is_functor) cf_ua_of_if_ntcf_ua_of_is_iso_ntcf:
assumes "r ∈⇩∘ 𝔄⦇Obj⦈"
and "u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
and "ntcf_ua_of α 𝔉 c r u :
Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉 : 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
shows "universal_arrow_of 𝔉 c r u"
proof(rule universal_arrow_ofI)
interpret ua_of_u: is_iso_ntcf
α
𝔄
‹cat_Set α›
‹Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-)›
‹Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉›
‹ntcf_ua_of α 𝔉 c r u›
by (rule assms(3))
fix r' u' assume prems: "r' ∈⇩∘ 𝔄⦇Obj⦈" "u' : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r'⦈"
have "ntcf_ua_of α 𝔉 c r u⦇NTMap⦈⦇r'⦈ :
Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-)⦇ObjMap⦈⦇r'⦈ ↦⇩i⇩s⇩o⇘cat_Set α⇙
(Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉)⦇ObjMap⦈⦇r'⦈"
by (rule is_iso_ntcf.iso_ntcf_is_arr_isomorphism[OF assms(3) prems(1)])
from this is_functor_axioms assms(1-2) prems have uof_r':
"umap_of 𝔉 c r u r' : Hom 𝔄 r r' ↦⇩i⇩s⇩o⇘cat_Set α⇙ Hom 𝔅 c (𝔉⦇ObjMap⦈⦇r'⦈)"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
note uof_r' = cat_Set_is_arr_isomorphismD[OF uof_r']
interpret uof_r': v11 ‹umap_of 𝔉 c r u r'⦇ArrVal⦈› by (rule uof_r'(2))
from
uof_r'.v11_vrange_ex1_eq[
THEN iffD1, unfolded uof_r'(3,4) in_Hom_iff, OF prems(2)
]
show "∃!f'. f' : r ↦⇘𝔄⇙ r' ∧ u' = umap_of 𝔉 c r u r'⦇ArrVal⦈⦇f'⦈"
by metis
qed (intro assms)+
lemma (in is_functor) cf_ua_fo_if_ntcf_ua_fo_is_iso_ntcf:
assumes "r ∈⇩∘ 𝔄⦇Obj⦈"
and "u : 𝔉⦇ObjMap⦈⦇r⦈ ↦⇘𝔅⇙ c"
and "ntcf_ua_fo α 𝔉 c r u :
Hom⇩O⇩.⇩C⇘α⇙𝔄(-,r) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙𝔅(-,c) ∘⇩C⇩F op_cf 𝔉 :
op_cat 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
shows "universal_arrow_fo 𝔉 c r u"
proof-
from assms(2) have c: "c ∈⇩∘ 𝔅⦇Obj⦈" by auto
show ?thesis
by
(
rule is_functor.cf_ua_of_if_ntcf_ua_of_is_iso_ntcf
[
OF is_functor_op,
unfolded cat_op_simps,
OF assms(1,2),
unfolded
HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)]
HomCod.cat_op_cat_cf_Hom_snd[OF c]
ntcf_ua_fo_def[symmetric],
OF assms(3)
]
)
qed
lemma (in is_functor) cf_universal_arrow_of_if_is_iso_ntcf:
assumes "r ∈⇩∘ 𝔄⦇Obj⦈"
and "c ∈⇩∘ 𝔅⦇Obj⦈"
and "φ :
Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉 :
𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
shows "universal_arrow_of 𝔉 c r (φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈)"
(is ‹universal_arrow_of 𝔉 c r ?u›)
proof-
interpret φ: is_iso_ntcf
α 𝔄 ‹cat_Set α› ‹Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-)› ‹Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉› φ
by (rule assms(3))
show ?thesis
proof(intro universal_arrow_ofI assms)
from assms(1,2) show u: "?u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
fix r' u' assume prems: "r' ∈⇩∘ 𝔄⦇Obj⦈" "u' : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r'⦈"
have φr'_ArrVal_app[symmetric, cat_cs_simps]:
"φ⦇NTMap⦈⦇r'⦈⦇ArrVal⦈⦇f'⦈ =
𝔉⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘𝔅⇙ φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
if "f' : r ↦⇘𝔄⇙ r'" for f'
proof-
have "φ⦇NTMap⦈⦇r'⦈ ∘⇩A⇘cat_Set α⇙ Hom⇩O⇩.⇩C⇘α⇙𝔄(r,-)⦇ArrMap⦈⦇f'⦈ =
(Hom⇩O⇩.⇩C⇘α⇙𝔅(c,-) ∘⇩C⇩F 𝔉)⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘cat_Set α⇙ φ⦇NTMap⦈⦇r⦈"
using that by (intro φ.ntcf_Comp_commute)
then have
"φ⦇NTMap⦈⦇r'⦈ ∘⇩A⇘cat_Set α⇙ cf_hom 𝔄 [𝔄⦇CId⦈⦇r⦈, f']⇩∘ =
cf_hom 𝔅 [𝔅⦇CId⦈⦇c⦈, 𝔉⦇ArrMap⦈⦇f'⦈]⇩∘ ∘⇩A⇘cat_Set α⇙ φ⦇NTMap⦈⦇r⦈"
using assms(1,2) that prems
by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
then have
"(φ⦇NTMap⦈⦇r'⦈ ∘⇩A⇘cat_Set α⇙
cf_hom 𝔄 [𝔄⦇CId⦈⦇r⦈, f']⇩∘)⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈ =
(cf_hom 𝔅 [𝔅⦇CId⦈⦇c⦈, 𝔉⦇ArrMap⦈⦇f'⦈]⇩∘ ∘⇩A⇘cat_Set α⇙
φ⦇NTMap⦈⦇r⦈)⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
by simp
from this assms(1,2) u that show ?thesis
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
show "∃!f'. f' : r ↦⇘𝔄⇙ r' ∧ u' = umap_of 𝔉 c r ?u r'⦇ArrVal⦈⦇f'⦈"
proof(intro ex1I conjI; (elim conjE)?)
from assms prems show
"(φ⦇NTMap⦈⦇r'⦈)¯⇩C⇘cat_Set α⇙⦇ArrVal⦈⦇u'⦈ : r ↦⇘𝔄⇙ r'"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_arrow_cs_intros
)
with assms(1,2) prems show "u' =
umap_of 𝔉 c r ?u r'⦇ArrVal⦈⦇(φ⦇NTMap⦈⦇r'⦈)¯⇩C⇘cat_Set α⇙⦇ArrVal⦈⦇u'⦈⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
)
fix f' assume prems':
"f' : r ↦⇘𝔄⇙ r'"
"u' = umap_of 𝔉 c r (φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈) r'⦇ArrVal⦈⦇f'⦈"
from prems'(2,1) assms(1,2) have u'_def:
"u' = 𝔉⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘𝔅⇙ φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
from prems' show "f' = (φ⦇NTMap⦈⦇r'⦈)¯⇩C⇘cat_Set α⇙⦇ArrVal⦈⦇u'⦈"
unfolding u'_def φr'_ArrVal_app[OF prems'(1)]
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
)
qed
qed
qed
lemma (in is_functor) cf_universal_arrow_fo_if_is_iso_ntcf:
assumes "r ∈⇩∘ 𝔄⦇Obj⦈"
and "c ∈⇩∘ 𝔅⦇Obj⦈"
and "φ :
Hom⇩O⇩.⇩C⇘α⇙𝔄(-,r) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙𝔅(-,c) ∘⇩C⇩F op_cf 𝔉 :
op_cat 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
shows "universal_arrow_fo 𝔉 c r (φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈)"
by
(
rule is_functor.cf_universal_arrow_of_if_is_iso_ntcf
[
OF is_functor_op,
unfolded cat_op_simps,
OF assms(1,2),
unfolded
HomDom.cat_op_cat_cf_Hom_snd[OF assms(1)]
HomCod.cat_op_cat_cf_Hom_snd[OF assms(2)]
ntcf_ua_fo_def[symmetric],
OF assms(3)
]
)
lemma (in is_functor) cf_universal_arrow_of_if_is_iso_ntcf_if_ge_Limit:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "r ∈⇩∘ 𝔄⦇Obj⦈"
and "c ∈⇩∘ 𝔅⦇Obj⦈"
and "φ :
Hom⇩O⇩.⇩C⇘β⇙𝔄(r,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘β⇙𝔅(c,-) ∘⇩C⇩F 𝔉 :
𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
shows "universal_arrow_of 𝔉 c r (φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈)"
(is ‹universal_arrow_of 𝔉 c r ?u›)
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret cat_Set_αβ: subcategory β ‹cat_Set α› ‹cat_Set β›
by (rule subcategory_cat_Set_cat_Set[OF assms(1,2)])
interpret φ: is_iso_ntcf
β 𝔄 ‹cat_Set β› ‹Hom⇩O⇩.⇩C⇘β⇙𝔄(r,-)› ‹Hom⇩O⇩.⇩C⇘β⇙𝔅(c,-) ∘⇩C⇩F 𝔉› φ
by (rule assms(5))
interpret β𝔄: category β 𝔄
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
interpret β𝔅: category β 𝔅
by (rule category.cat_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
interpret β𝔉: is_functor β 𝔄 𝔅 𝔉
by (rule cf_is_functor_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
show ?thesis
proof(intro universal_arrow_ofI assms)
from assms(3,4) show u: "?u : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r⦈"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
fix r' u' assume prems: "r' ∈⇩∘ 𝔄⦇Obj⦈" "u' : c ↦⇘𝔅⇙ 𝔉⦇ObjMap⦈⦇r'⦈"
have φr'_ArrVal_app[symmetric, cat_cs_simps]:
"φ⦇NTMap⦈⦇r'⦈⦇ArrVal⦈⦇f'⦈ =
𝔉⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘𝔅⇙ φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
if "f' : r ↦⇘𝔄⇙ r'" for f'
proof-
have "φ⦇NTMap⦈⦇r'⦈ ∘⇩A⇘cat_Set β⇙ Hom⇩O⇩.⇩C⇘β⇙𝔄(r,-)⦇ArrMap⦈⦇f'⦈ =
(Hom⇩O⇩.⇩C⇘β⇙𝔅(c,-) ∘⇩C⇩F 𝔉)⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘cat_Set β⇙ φ⦇NTMap⦈⦇r⦈"
using that by (intro φ.ntcf_Comp_commute)
then have
"φ⦇NTMap⦈⦇r'⦈ ∘⇩A⇘cat_Set β⇙ cf_hom 𝔄 [𝔄⦇CId⦈⦇r⦈, f']⇩∘ =
cf_hom 𝔅 [𝔅⦇CId⦈⦇c⦈, 𝔉⦇ArrMap⦈⦇f'⦈]⇩∘ ∘⇩A⇘cat_Set β⇙ φ⦇NTMap⦈⦇r⦈"
using assms(3,4) assms(1,2) that prems
by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
then have
"(φ⦇NTMap⦈⦇r'⦈ ∘⇩A⇘cat_Set β⇙
cf_hom 𝔄 [𝔄⦇CId⦈⦇r⦈, f']⇩∘)⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈ =
(cf_hom 𝔅 [𝔅⦇CId⦈⦇c⦈, 𝔉⦇ArrMap⦈⦇f'⦈]⇩∘ ∘⇩A⇘cat_Set β⇙
φ⦇NTMap⦈⦇r⦈)⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
by simp
from
this assms(3,4,2) u that HomDom.category_axioms HomCod.category_axioms
show ?thesis
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro:
cat_cs_intros
cat_op_intros
cat_prod_cs_intros
cat_Set_αβ.subcat_is_arrD
)
qed
show "∃!f'. f' : r ↦⇘𝔄⇙ r' ∧ u' = umap_of 𝔉 c r ?u r'⦇ArrVal⦈⦇f'⦈"
proof(intro ex1I conjI; (elim conjE)?)
from assms prems HomDom.category_axioms show
"(φ⦇NTMap⦈⦇r'⦈)¯⇩C⇘cat_Set β⇙⦇ArrVal⦈⦇u'⦈ : r ↦⇘𝔄⇙ r'"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_arrow_cs_intros
)
with assms(3,4) prems show "u' =
umap_of 𝔉 c r ?u r'⦇ArrVal⦈⦇(φ⦇NTMap⦈⦇r'⦈)¯⇩C⇘cat_Set β⇙⦇ArrVal⦈⦇u'⦈⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
)
fix f' assume prems':
"f' : r ↦⇘𝔄⇙ r'"
"u' = umap_of 𝔉 c r (φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈) r'⦇ArrVal⦈⦇f'⦈"
from prems'(2,1) assms(3,4) have u'_def:
"u' = 𝔉⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘𝔅⇙ φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
from prems' show "f' = (φ⦇NTMap⦈⦇r'⦈)¯⇩C⇘cat_Set β⇙⦇ArrVal⦈⦇u'⦈"
unfolding u'_def φr'_ArrVal_app[OF prems'(1)]
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_arrow_cs_intros cat_cs_intros cat_op_intros
)
qed
qed
qed
lemma (in is_functor) cf_universal_arrow_fo_if_is_iso_ntcf_if_ge_Limit:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "r ∈⇩∘ 𝔄⦇Obj⦈"
and "c ∈⇩∘ 𝔅⦇Obj⦈"
and "φ :
Hom⇩O⇩.⇩C⇘β⇙𝔄(-,r) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘β⇙𝔅(-,c) ∘⇩C⇩F op_cf 𝔉 :
op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
shows "universal_arrow_fo 𝔉 c r (φ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇r⦈⦈)"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret β𝔉: is_functor β 𝔄 𝔅 𝔉
by (rule cf_is_functor_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_intro: cat_cs_intros›)+
show ?thesis
by
(
rule is_functor.cf_universal_arrow_of_if_is_iso_ntcf_if_ge_Limit
[
OF is_functor_op,
OF assms(1,2),
unfolded cat_op_simps,
OF assms(3,4),
unfolded
β𝔉.HomDom.cat_op_cat_cf_Hom_snd[OF assms(3)]
β𝔉.HomCod.cat_op_cat_cf_Hom_snd[OF assms(4)]
ntcf_ua_fo_def[symmetric],
OF assms(5)
]
)
qed
text‹\newpage›
end
Theory CZH_UCAT_Limit
section‹Limits›
theory CZH_UCAT_Limit
imports
CZH_UCAT_Universal
CZH_Elementary_Categories.CZH_ECAT_Discrete
CZH_Elementary_Categories.CZH_ECAT_SS
CZH_Elementary_Categories.CZH_ECAT_Parallel
begin
subsection‹Background›
named_theorems cat_lim_cs_simps
named_theorems cat_lim_cs_intros
subsection‹Cone and cocone›
text‹
In the context of this work, the concept of a cone corresponds to that of a cone
to the base of a functor from a vertex, as defined in Chapter III-4 in
\cite{mac_lane_categories_2010}; the concept of a cocone corresponds to that
of a cone from the base of a functor to a vertex, as defined in Chapter III-3
in \cite{mac_lane_categories_2010}.
In this body of work, only limits and colimits of functors with tiny maps
are considered. The definitions of a cone and a cocone also reflect this.
However, this restriction may be removed in the future.
›
locale is_cat_cone = is_tm_ntcf α 𝔍 ℭ ‹cf_const 𝔍 ℭ c› 𝔉 𝔑 for α c 𝔍 ℭ 𝔉 𝔑 +
assumes cat_cone_obj[cat_lim_cs_intros]: "c ∈⇩∘ ℭ⦇Obj⦈"
syntax "_is_cat_cone" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ <⇩C⇩F⇩.⇩c⇩o⇩n⇩e _ :/ _ ↦↦⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "𝔑 : c <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_cone α c 𝔍 ℭ 𝔉 𝔑"
locale is_cat_cocone = is_tm_ntcf α 𝔍 ℭ 𝔉 ‹cf_const 𝔍 ℭ c› 𝔑 for α c 𝔍 ℭ 𝔉 𝔑 +
assumes cat_cocone_obj[cat_lim_cs_intros]: "c ∈⇩∘ ℭ⦇Obj⦈"
syntax "_is_cat_cocone" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e _ :/ _ ↦↦⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "𝔑 : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e c : 𝔍 ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_cocone α c 𝔍 ℭ 𝔉 𝔑"
text‹Rules.›
lemma (in is_cat_cone) is_cat_cone_axioms'[cat_lim_cs_intros]:
assumes "α' = α" and "c' = c" and "𝔍' = 𝔍" and "ℭ' = ℭ" and "𝔉' = 𝔉"
shows "𝔑 : c' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉' : 𝔍' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_cone_axioms)
mk_ide rf is_cat_cone_def[unfolded is_cat_cone_axioms_def]
|intro is_cat_coneI|
|dest is_cat_coneD[dest!]|
|elim is_cat_coneE[elim!]|
lemma (in is_cat_cone) is_cat_coneD'[cat_lim_cs_intros]:
assumes "c' = cf_const 𝔍 ℭ c"
shows "𝔑 : c' ↦⇩C⇩F⇩.⇩t⇩m 𝔉 : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
unfolding assms by (cs_concl cs_intro: cat_small_cs_intros)
lemmas [cat_lim_cs_intros] = is_cat_cone.is_cat_coneD'
lemma (in is_cat_cocone) is_cat_cocone_axioms'[cat_lim_cs_intros]:
assumes "α' = α" and "c' = c" and "𝔍' = 𝔍" and "ℭ' = ℭ" and "𝔉' = 𝔉"
shows "𝔑 : 𝔉' >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e c' : 𝔍' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_cocone_axioms)
mk_ide rf is_cat_cocone_def[unfolded is_cat_cocone_axioms_def]
|intro is_cat_coconeI|
|dest is_cat_coconeD[dest!]|
|elim is_cat_coconeE[elim!]|
lemma (in is_cat_cocone) is_cat_coconeD'[cat_lim_cs_intros]:
assumes "c' = cf_const 𝔍 ℭ c"
shows "𝔑 : 𝔉 ↦⇩C⇩F⇩.⇩t⇩m c' : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
unfolding assms by (cs_concl cs_intro: cat_small_cs_intros)
lemmas [cat_lim_cs_intros] = is_cat_cocone.is_cat_coconeD'
text‹Duality.›
lemma (in is_cat_cone) is_cat_cocone_op:
"op_ntcf 𝔑 : op_cf 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e c : op_cat 𝔍 ↦↦⇩C⇘α⇙ op_cat ℭ"
by (intro is_cat_coconeI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_lim_cs_intros cat_op_intros)+
lemma (in is_cat_cone) is_cat_cocone_op'[cat_op_intros]:
assumes "α' = α" and "𝔍' = op_cat 𝔍" and "ℭ' = op_cat ℭ" and "𝔉' = op_cf 𝔉"
shows "op_ntcf 𝔑 : 𝔉' >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e c : 𝔍' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_cocone_op)
lemmas [cat_op_intros] = is_cat_cone.is_cat_cocone_op'
lemma (in is_cat_cocone) is_cat_cone_op:
"op_ntcf 𝔑 : c <⇩C⇩F⇩.⇩c⇩o⇩n⇩e op_cf 𝔉 : op_cat 𝔍 ↦↦⇩C⇘α⇙ op_cat ℭ"
by (intro is_cat_coneI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_lim_cs_intros cat_op_intros)
lemma (in is_cat_cocone) is_cat_cone_op'[cat_op_intros]:
assumes "α' = α" and "𝔍' = op_cat 𝔍" and "ℭ' = op_cat ℭ" and "𝔉' = op_cf 𝔉"
shows "op_ntcf 𝔑 : c <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉' : 𝔍' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_cone_op)
lemmas [cat_op_intros] = is_cat_cocone.is_cat_cone_op'
text‹Elementary properties.›
lemma (in is_cat_cone) cat_cone_LArr_app_is_arr:
assumes "j ∈⇩∘ 𝔍⦇Obj⦈"
shows "𝔑⦇NTMap⦈⦇j⦈ : c ↦⇘ℭ⇙ 𝔉⦇ObjMap⦈⦇j⦈"
proof-
from assms have [simp]: "cf_const 𝔍 ℭ c⦇ObjMap⦈⦇j⦈ = c"
by (cs_concl cs_simp: cat_cs_simps)
from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp
qed
lemma (in is_cat_cone) cat_cone_LArr_app_is_arr'[cat_lim_cs_intros]:
assumes "j ∈⇩∘ 𝔍⦇Obj⦈" and "𝔉j = 𝔉⦇ObjMap⦈⦇j⦈"
shows "𝔑⦇NTMap⦈⦇j⦈ : c ↦⇘ℭ⇙ 𝔉j"
using assms(1) unfolding assms(2) by (rule cat_cone_LArr_app_is_arr)
lemmas [cat_lim_cs_intros] = is_cat_cone.cat_cone_LArr_app_is_arr'
lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr:
assumes "j ∈⇩∘ 𝔍⦇Obj⦈"
shows "𝔑⦇NTMap⦈⦇j⦈ : 𝔉⦇ObjMap⦈⦇j⦈ ↦⇘ℭ⇙ c"
proof-
from assms have [simp]: "cf_const 𝔍 ℭ c⦇ObjMap⦈⦇j⦈ = c"
by (cs_concl cs_simp: cat_cs_simps)
from ntcf_NTMap_is_arr[OF assms] show ?thesis by simp
qed
lemma (in is_cat_cocone) cat_cocone_LArr_app_is_arr'[cat_lim_cs_intros]:
assumes "j ∈⇩∘ 𝔍⦇Obj⦈" and "𝔉j = 𝔉⦇ObjMap⦈⦇j⦈"
shows "𝔑⦇NTMap⦈⦇j⦈ : 𝔉j ↦⇘ℭ⇙ c"
using assms(1) unfolding assms(2) by (rule cat_cocone_LArr_app_is_arr)
lemmas [cat_lim_cs_intros] = is_cat_cocone.cat_cocone_LArr_app_is_arr'
lemma (in is_cat_cone) cat_cone_Comp_commute[cat_lim_cs_simps]:
assumes "f : a ↦⇘𝔍⇙ b"
shows "𝔉⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ 𝔑⦇NTMap⦈⦇a⦈ = 𝔑⦇NTMap⦈⦇b⦈"
using ntcf_Comp_commute[symmetric, OF assms] assms
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemmas [cat_lim_cs_simps] = is_cat_cone.cat_cone_Comp_commute
lemma (in is_cat_cocone) cat_cocone_Comp_commute[cat_lim_cs_simps]:
assumes "f : a ↦⇘𝔍⇙ b"
shows "𝔑⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ 𝔉⦇ArrMap⦈⦇f⦈ = 𝔑⦇NTMap⦈⦇a⦈"
using ntcf_Comp_commute[OF assms] assms
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
lemmas [cat_lim_cs_simps] = is_cat_cocone.cat_cocone_Comp_commute
text‹Utilities/helper lemmas.›
lemma (in is_cat_cone) helper_cat_cone_ntcf_vcomp_Comp:
assumes "𝔑' : c' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
and "f' : c' ↦⇘ℭ⇙ c"
and "𝔑' = 𝔑 ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f'"
and "j ∈⇩∘ 𝔍⦇Obj⦈"
shows "𝔑'⦇NTMap⦈⦇j⦈ = 𝔑⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f'"
proof-
from assms(3) have "𝔑'⦇NTMap⦈⦇j⦈ = (𝔑 ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f')⦇NTMap⦈⦇j⦈"
by simp
from this assms(1,2,4) show "𝔑'⦇NTMap⦈⦇j⦈ = 𝔑⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f'"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp:
assumes "𝔑' : c' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
and "f' : c' ↦⇘ℭ⇙ c"
and "⋀j. j ∈⇩∘ 𝔍⦇Obj⦈ ⟹ 𝔑'⦇NTMap⦈⦇j⦈ = 𝔑⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f'"
shows "𝔑' = 𝔑 ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f'"
proof-
interpret 𝔑': is_cat_cone α c' 𝔍 ℭ 𝔉 𝔑' by (rule assms(1))
show ?thesis
proof(rule ntcf_eqI[OF 𝔑'.is_ntcf_axioms])
from assms(2) show
"𝔑 ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f' : cf_const 𝔍 ℭ c' ↦⇩C⇩F 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "𝔑'⦇NTMap⦈ = (𝔑 ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f')⦇NTMap⦈"
proof(rule vsv_eqI, unfold cat_cs_simps)
show "vsv ((𝔑 ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f')⦇NTMap⦈)"
by (cs_concl cs_intro: cat_cs_intros)
from assms show "𝔍⦇Obj⦈ = 𝒟⇩∘ ((𝔑 ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f')⦇NTMap⦈)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
fix j assume prems': "j ∈⇩∘ 𝔍⦇Obj⦈"
with assms(1,2) show "𝔑'⦇NTMap⦈⦇j⦈ = (𝔑 ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f')⦇NTMap⦈⦇j⦈"
by (cs_concl cs_simp: cat_cs_simps assms(3) cs_intro: cat_cs_intros)
qed auto
qed simp_all
qed
lemma (in is_cat_cone) helper_cat_cone_Comp_ntcf_vcomp_iff:
assumes "𝔑' : c' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
shows "f' : c' ↦⇘ℭ⇙ c ∧ 𝔑' = 𝔑 ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f' ⟷
f' : c' ↦⇘ℭ⇙ c ∧ (∀j∈⇩∘𝔍⦇Obj⦈. 𝔑'⦇NTMap⦈⦇j⦈ = 𝔑⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f')"
using
helper_cat_cone_ntcf_vcomp_Comp[OF assms]
helper_cat_cone_Comp_ntcf_vcomp[OF assms]
by (intro iffI; elim conjE; intro conjI) metis+
lemma (in is_cat_cocone) helper_cat_cocone_ntcf_vcomp_Comp:
assumes "𝔑' : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e c' : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
and "f' : c ↦⇘ℭ⇙ c'"
and "𝔑' = ntcf_const 𝔍 ℭ f' ∙⇩N⇩T⇩C⇩F 𝔑"
and "j ∈⇩∘ 𝔍⦇Obj⦈"
shows "𝔑'⦇NTMap⦈⦇j⦈ = f' ∘⇩A⇘ℭ⇙ 𝔑⦇NTMap⦈⦇j⦈"
proof-
interpret 𝔑': is_cat_cocone α c' 𝔍 ℭ 𝔉 𝔑' by (rule assms(1))
from assms(3) have "op_ntcf 𝔑' = op_ntcf (ntcf_const 𝔍 ℭ f' ∙⇩N⇩T⇩C⇩F 𝔑)" by simp
from this assms(2) have op_𝔑':
"op_ntcf 𝔑' = op_ntcf 𝔑 ∙⇩N⇩T⇩C⇩F ntcf_const (op_cat 𝔍) (op_cat ℭ) f'"
by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
have "𝔑'⦇NTMap⦈⦇j⦈ = 𝔑⦇NTMap⦈⦇j⦈ ∘⇩A⇘op_cat ℭ⇙ f'"
by
(
rule is_cat_cone.helper_cat_cone_ntcf_vcomp_Comp[
OF is_cat_cone_op 𝔑'.is_cat_cone_op,
unfolded cat_op_simps,
OF assms(2) op_𝔑' assms(4)
]
)
from this assms(2,4) show "𝔑'⦇NTMap⦈⦇j⦈ = f' ∘⇩A⇘ℭ⇙ 𝔑⦇NTMap⦈⦇j⦈"
by (cs_prems cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
qed
lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp:
assumes "𝔑' : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e c' : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
and "f' : c ↦⇘ℭ⇙ c'"
and "⋀j. j ∈⇩∘ 𝔍⦇Obj⦈ ⟹ 𝔑'⦇NTMap⦈⦇j⦈ = f' ∘⇩A⇘ℭ⇙ 𝔑⦇NTMap⦈⦇j⦈"
shows "𝔑' = ntcf_const 𝔍 ℭ f' ∙⇩N⇩T⇩C⇩F 𝔑"
proof-
interpret 𝔑': is_cat_cocone α c' 𝔍 ℭ 𝔉 𝔑' by (rule assms(1))
from assms(2) have 𝔑'j: "𝔑'⦇NTMap⦈⦇j⦈ = 𝔑⦇NTMap⦈⦇j⦈ ∘⇩A⇘op_cat ℭ⇙ f'"
if "j ∈⇩∘ 𝔍⦇Obj⦈" for j
using that
unfolding assms(3)[OF that]
by (cs_concl cs_simp: cat_op_simps cat_cs_simps cs_intro: cat_cs_intros)
have op_𝔑':
"op_ntcf 𝔑' = op_ntcf 𝔑 ∙⇩N⇩T⇩C⇩F ntcf_const (op_cat 𝔍) (op_cat ℭ) f'"
by
(
rule is_cat_cone.helper_cat_cone_Comp_ntcf_vcomp[
OF is_cat_cone_op 𝔑'.is_cat_cone_op,
unfolded cat_op_simps,
OF assms(2) 𝔑'j,
simplified
]
)
from assms(2) show "𝔑' = (ntcf_const 𝔍 ℭ f' ∙⇩N⇩T⇩C⇩F 𝔑)"
by
(
cs_concl
cs_simp:
cat_op_simps op_𝔑' eq_op_ntcf_iff[symmetric, OF 𝔑'.is_ntcf_axioms]
cs_intro: cat_cs_intros
)
qed
lemma (in is_cat_cocone) helper_cat_cocone_Comp_ntcf_vcomp_iff:
assumes "𝔑' : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e c' : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
shows "f' : c ↦⇘ℭ⇙ c' ∧ 𝔑' = ntcf_const 𝔍 ℭ f' ∙⇩N⇩T⇩C⇩F 𝔑 ⟷
f' : c ↦⇘ℭ⇙ c' ∧ (∀j∈⇩∘𝔍⦇Obj⦈. 𝔑'⦇NTMap⦈⦇j⦈ = f' ∘⇩A⇘ℭ⇙ 𝔑⦇NTMap⦈⦇j⦈)"
using
helper_cat_cocone_ntcf_vcomp_Comp[OF assms]
helper_cat_cocone_Comp_ntcf_vcomp[OF assms]
by (intro iffI; elim conjE; intro conjI) metis+
subsection‹Limit and colimit›
subsubsection‹Definition and elementary properties›
text‹
The concept of a limit is introduced in Chapter III-4 in
\cite{mac_lane_categories_2010}; the concept of a colimit is introduced in
Chapter III-3 in \cite{mac_lane_categories_2010}.
›
locale is_cat_limit = is_cat_cone α r 𝔍 ℭ 𝔉 u for α 𝔍 ℭ 𝔉 r u +
assumes cat_lim_ua_fo:
"universal_arrow_fo (Δ⇩C α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u)"
syntax "_is_cat_limit" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ <⇩C⇩F⇩.⇩l⇩i⇩m _ :/ _ ↦↦⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_limit α 𝔍 ℭ 𝔉 r u"
locale is_cat_colimit = is_cat_cocone α r 𝔍 ℭ 𝔉 u for α 𝔍 ℭ 𝔉 r u +
assumes cat_colim_ua_fo: "universal_arrow_fo
(Δ⇩C α (op_cat 𝔍) (op_cat ℭ)) (cf_map 𝔉) r (ntcf_arrow (op_ntcf u))"
syntax "_is_cat_colimit" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m _ :/ _ ↦↦⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "u : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : 𝔍 ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_colimit α 𝔍 ℭ 𝔉 r u"
text‹Rules.›
lemma (in is_cat_limit) is_cat_limit_axioms'[cat_lim_cs_intros]:
assumes "α' = α" and "r' = r" and "𝔍' = 𝔍" and "ℭ' = ℭ" and "𝔉' = 𝔉"
shows "u : r' <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉' : 𝔍' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_limit_axioms)
mk_ide rf is_cat_limit_def[unfolded is_cat_limit_axioms_def]
|intro is_cat_limitI|
|dest is_cat_limitD[dest]|
|elim is_cat_limitE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_limitD(1)
lemma (in is_cat_colimit) is_cat_colimit_axioms'[cat_lim_cs_intros]:
assumes "α' = α" and "r' = r" and "𝔍' = 𝔍" and "ℭ' = ℭ" and "𝔉' = 𝔉"
shows "u : 𝔉' >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r' : 𝔍' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_colimit_axioms)
mk_ide rf is_cat_colimit_def[unfolded is_cat_colimit_axioms_def]
|intro is_cat_colimitI|
|dest is_cat_colimitD[dest]|
|elim is_cat_colimitE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_colimitD(1)
text‹Duality›
lemma (in is_cat_limit) is_cat_colimit_op:
"op_ntcf u : op_cf 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : op_cat 𝔍 ↦↦⇩C⇘α⇙ op_cat ℭ"
using cat_lim_ua_fo
by (intro is_cat_colimitI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
lemma (in is_cat_limit) is_cat_colimit_op'[cat_op_intros]:
assumes "𝔉' = op_cf 𝔉" and "𝔍' = op_cat 𝔍" and "ℭ' = op_cat ℭ"
shows "op_ntcf u : 𝔉' >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : 𝔍' ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_colimit_op)
lemmas [cat_op_intros] = is_cat_limit.is_cat_colimit_op'
lemma (in is_cat_colimit) is_cat_limit_op:
"op_ntcf u : r <⇩C⇩F⇩.⇩l⇩i⇩m op_cf 𝔉 : op_cat 𝔍 ↦↦⇩C⇘α⇙ op_cat ℭ"
using cat_colim_ua_fo
by (intro is_cat_limitI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
lemma (in is_cat_colimit) is_cat_colimit_op'[cat_op_intros]:
assumes "𝔉' = op_cf 𝔉" and "𝔍' = op_cat 𝔍" and "ℭ' = op_cat ℭ"
shows "op_ntcf u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉' : 𝔍' ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_limit_op)
lemmas [cat_op_intros] = is_cat_colimit.is_cat_colimit_op'
text‹Elementary properties of limits and colimits.›
sublocale is_cat_limit ⊆ Δ: is_functor α ℭ ‹cat_Funct α 𝔍 ℭ› ‹Δ⇩C α 𝔍 ℭ›
by (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)
sublocale is_cat_colimit ⊆ Δ: is_functor
α ‹op_cat ℭ› ‹cat_Funct α (op_cat 𝔍) (op_cat ℭ)› ‹Δ⇩C α (op_cat 𝔍) (op_cat ℭ)›
by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros cat_op_intros)
subsubsection‹Universal property›
lemma is_cat_limitI':
assumes "u : r <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
and "⋀u' r'. ⟦ u' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ ⟧ ⟹
∃!f'. f' : r' ↦⇘ℭ⇙ r ∧ u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f'"
shows "u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
proof(intro is_cat_limitI is_functor.universal_arrow_foI)
interpret u: is_cat_cone α r 𝔍 ℭ 𝔉 u by (rule assms(1))
show "r ∈⇩∘ ℭ⦇Obj⦈" by (cs_concl cs_intro: cat_lim_cs_intros)
show "Δ⇩C α 𝔍 ℭ : ℭ ↦↦⇩C⇘α⇙ cat_Funct α 𝔍 ℭ"
by (cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)
show "ntcf_arrow u : Δ⇩C α 𝔍 ℭ⦇ObjMap⦈⦇r⦈ ↦⇘cat_Funct α 𝔍 ℭ⇙ cf_map 𝔉"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_lim_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
)
fix r' u' assume prems:
"r' ∈⇩∘ ℭ⦇Obj⦈" "u' : Δ⇩C α 𝔍 ℭ⦇ObjMap⦈⦇r'⦈ ↦⇘cat_Funct α 𝔍 ℭ⇙ cf_map 𝔉"
note u' = cat_Funct_is_arrD[OF prems(2)]
from u'(1) prems(1) have u'_is_tm_ntcf:
"ntcf_of_ntcf_arrow 𝔍 ℭ u' : cf_const 𝔍 ℭ r' ↦⇩C⇩F⇩.⇩t⇩m 𝔉 : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
by
(
cs_prems
cs_simp: cat_cs_simps cat_small_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros
)
from this prems(1) have u'_is_cat_cone:
"ntcf_of_ntcf_arrow 𝔍 ℭ u' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
by (intro is_cat_coneI)
interpret u': is_cat_cone α r' 𝔍 ℭ 𝔉 ‹ntcf_of_ntcf_arrow 𝔍 ℭ u'›
by (rule u'_is_cat_cone)
from assms(2)[OF u'_is_cat_cone] obtain f' where f': "f' : r' ↦⇘ℭ⇙ r"
and u'_def: "ntcf_of_ntcf_arrow 𝔍 ℭ u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f'"
and unique: "⋀f''.
⟦
f'' : r' ↦⇘ℭ⇙ r;
ntcf_of_ntcf_arrow 𝔍 ℭ u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f''
⟧ ⟹ f'' = f'"
by (meson prems(1))
from u'_def have u'_NTMap_app:
"ntcf_of_ntcf_arrow 𝔍 ℭ u'⦇NTMap⦈⦇j⦈ = (u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f')⦇NTMap⦈⦇j⦈"
if "j ∈⇩∘ 𝔍⦇Obj⦈" for j
by simp
have u'_NTMap_app: "u'⦇NTMap⦈⦇j⦈ = u⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f'"
if "j ∈⇩∘ 𝔍⦇Obj⦈" for j
using u'_NTMap_app[OF that] that f'
by (cs_prems cs_simp: cat_cs_simps cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
show "∃!f'.
f' : r' ↦⇘ℭ⇙ r ∧
u' = umap_fo (Δ⇩C α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f'⦈"
proof(intro ex1I conjI; (elim conjE)?)
show "f' : r' ↦⇘ℭ⇙ r" by (rule f')
have u'_def'[symmetric, cat_cs_simps]:
"ntcf_of_ntcf_arrow 𝔍 ℭ u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f'"
proof(rule ntcf_eqI)
from u'_is_tm_ntcf show
"ntcf_of_ntcf_arrow 𝔍 ℭ u' : cf_const 𝔍 ℭ r' ↦⇩C⇩F 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_intro: cat_small_cs_intros)
from f' show
"u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f' : cf_const 𝔍 ℭ r' ↦⇩C⇩F 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show
"ntcf_of_ntcf_arrow 𝔍 ℭ u'⦇NTMap⦈ = (u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f')⦇NTMap⦈"
proof(rule vsv_eqI)
from f' show "𝒟⇩∘ (ntcf_of_ntcf_arrow 𝔍 ℭ u'⦇NTMap⦈) =
𝒟⇩∘ ((u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f')⦇NTMap⦈)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "ntcf_of_ntcf_arrow 𝔍 ℭ u'⦇NTMap⦈⦇a⦈ =
(u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f')⦇NTMap⦈⦇a⦈"
if "a ∈⇩∘ 𝒟⇩∘ (ntcf_of_ntcf_arrow 𝔍 ℭ u'⦇NTMap⦈)" for a
proof-
from that have "a ∈⇩∘ 𝔍⦇Obj⦈" by (cs_prems cs_simp: cat_cs_simps)
with f' show
"ntcf_of_ntcf_arrow 𝔍 ℭ u'⦇NTMap⦈⦇a⦈ =
(u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f')⦇NTMap⦈⦇a⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps u'_NTMap_app
cs_intro: cat_cs_intros
)
qed
qed (auto intro: cat_cs_intros)
qed simp_all
from f' u'(1) show
"u' = umap_fo (Δ⇩C α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f'⦈"
by (subst u'(2))
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
)
fix f'' assume prems':
"f'' : r' ↦⇘ℭ⇙ r"
"u' = umap_fo (Δ⇩C α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f''⦈"
from prems'(2,1) u'(1) have
"ntcf_of_ntcf_arrow 𝔍 ℭ u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f''"
by (subst (asm) u'(2))
(
cs_prems
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from unique[OF prems'(1) this] show "f'' = f'" .
qed
qed (intro assms)+
lemma (in is_cat_limit) cat_lim_unique_cone:
assumes "u' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : r' ↦⇘ℭ⇙ r ∧ u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f'"
proof-
interpret u': is_cat_cone α r' 𝔍 ℭ 𝔉 u' by (rule assms(1))
have "ntcf_arrow u' : Δ⇩C α 𝔍 ℭ⦇ObjMap⦈⦇r'⦈ ↦⇘cat_Funct α 𝔍 ℭ⇙ cf_map 𝔉"
by
(
cs_concl
cs_intro: cat_lim_cs_intros cat_FUNCT_cs_intros cs_simp: cat_cs_simps
)
from Δ.universal_arrow_foD(3)[OF cat_lim_ua_fo u'.cat_cone_obj this] obtain f'
where f': "f' : r' ↦⇘ℭ⇙ r"
and u': "ntcf_arrow u' =
umap_fo (Δ⇩C α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f'⦈"
and unique:
"⟦
f'' : r' ↦⇘ℭ⇙ r;
ntcf_arrow u' =
umap_fo (Δ⇩C α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f''⦈
⟧ ⟹ f'' = f'"
for f''
by metis
show "∃!f'. f' : r' ↦⇘ℭ⇙ r ∧ u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f'"
proof(intro ex1I conjI; (elim conjE)?)
show "f' : r' ↦⇘ℭ⇙ r" by (rule f')
with u' show "u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f'"
by
(
cs_prems
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
)
fix f'' assume prems: "f'' : r' ↦⇘ℭ⇙ r" "u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f''"
from prems(1) have "ntcf_arrow u' =
umap_fo (Δ⇩C α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f''⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps prems(2)[symmetric]
cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
)
from prems(1) this show "f'' = f'" by (intro unique)
qed
qed
lemma (in is_cat_limit) cat_lim_unique_cone':
assumes "u' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
shows
"∃!f'. f' : r' ↦⇘ℭ⇙ r ∧ (∀j∈⇩∘𝔍⦇Obj⦈. u'⦇NTMap⦈⦇j⦈ = u⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f')"
by (fold helper_cat_cone_Comp_ntcf_vcomp_iff[OF assms(1)])
(intro cat_lim_unique_cone assms)
lemma (in is_cat_limit) cat_lim_unique:
assumes "u' : r' <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : r' ↦⇘ℭ⇙ r ∧ u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f'"
by (intro cat_lim_unique_cone[OF is_cat_limitD(1)[OF assms]])
lemma (in is_cat_limit) cat_lim_unique':
assumes "u' : r' <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
shows
"∃!f'. f' : r' ↦⇘ℭ⇙ r ∧ (∀j∈⇩∘𝔍⦇Obj⦈. u'⦇NTMap⦈⦇j⦈ = u⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f')"
by (intro cat_lim_unique_cone'[OF is_cat_limitD(1)[OF assms]])
lemma (in is_cat_colimit) cat_colim_unique_cocone:
assumes "u' : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e r' : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : r ↦⇘ℭ⇙ r' ∧ u' = ntcf_const 𝔍 ℭ f' ∙⇩N⇩T⇩C⇩F u"
proof-
interpret u': is_cat_cocone α r' 𝔍 ℭ 𝔉 u' by (rule assms(1))
from u'.cat_cocone_obj have op_r': "r' ∈⇩∘ op_cat ℭ⦇Obj⦈"
unfolding cat_op_simps by simp
from
is_cat_limit.cat_lim_unique_cone[
OF is_cat_limit_op u'.is_cat_cone_op, folded op_ntcf_ntcf_const
]
obtain f' where f': "f' : r' ↦⇘op_cat ℭ⇙ r"
and [cat_cs_simps]:
"op_ntcf u' = op_ntcf u ∙⇩N⇩T⇩C⇩F op_ntcf (ntcf_const 𝔍 ℭ f')"
and unique:
"⟦
f'' : r' ↦⇘op_cat ℭ⇙ r;
op_ntcf u' = op_ntcf u ∙⇩N⇩T⇩C⇩F op_ntcf (ntcf_const 𝔍 ℭ f'')
⟧ ⟹ f'' = f'"
for f''
by metis
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
from f' show f': "f' : r ↦⇘ℭ⇙ r'" unfolding cat_op_simps by simp
show "u' = ntcf_const 𝔍 ℭ f' ∙⇩N⇩T⇩C⇩F u"
by (rule eq_op_ntcf_iff[THEN iffD1], insert f')
(cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)+
fix f'' assume prems: "f'' : r ↦⇘ℭ⇙ r'" "u' = ntcf_const 𝔍 ℭ f'' ∙⇩N⇩T⇩C⇩F u"
from prems(1) have "f'' : r' ↦⇘op_cat ℭ⇙ r" unfolding cat_op_simps by simp
moreover from prems(1) have
"op_ntcf u' = op_ntcf u ∙⇩N⇩T⇩C⇩F op_ntcf (ntcf_const 𝔍 ℭ f'')"
unfolding prems(2)
by (cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)
ultimately show "f'' = f'" by (rule unique)
qed
qed
lemma (in is_cat_colimit) cat_colim_unique_cocone':
assumes "u' : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e r' : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
shows
"∃!f'. f' : r ↦⇘ℭ⇙ r' ∧ (∀j∈⇩∘𝔍⦇Obj⦈. u'⦇NTMap⦈⦇j⦈ = f' ∘⇩A⇘ℭ⇙ u⦇NTMap⦈⦇j⦈)"
by (fold helper_cat_cocone_Comp_ntcf_vcomp_iff[OF assms(1)])
(intro cat_colim_unique_cocone assms)
lemma (in is_cat_colimit) cat_colim_unique:
assumes "u' : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r' : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : r ↦⇘ℭ⇙ r' ∧ u' = ntcf_const 𝔍 ℭ f' ∙⇩N⇩T⇩C⇩F u"
by (intro cat_colim_unique_cocone[OF is_cat_colimitD(1)[OF assms]])
lemma (in is_cat_colimit) cat_colim_unique':
assumes "u' : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r' : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
shows
"∃!f'. f' : r ↦⇘ℭ⇙ r' ∧ (∀j∈⇩∘𝔍⦇Obj⦈. u'⦇NTMap⦈⦇j⦈ = f' ∘⇩A⇘ℭ⇙ u⦇NTMap⦈⦇j⦈)"
proof-
interpret u': is_cat_colimit α 𝔍 ℭ 𝔉 r' u' by (rule assms(1))
show ?thesis
by (fold helper_cat_cocone_Comp_ntcf_vcomp_iff[OF u'.is_cat_cocone_axioms])
(intro cat_colim_unique assms)
qed
lemma cat_lim_ex_is_arr_isomorphism:
assumes "u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
and "u' : r' <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : r' ↦⇩i⇩s⇩o⇘ℭ⇙ r" and "u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f"
proof-
interpret u: is_cat_limit α 𝔍 ℭ 𝔉 r u by (rule assms(1))
interpret u': is_cat_limit α 𝔍 ℭ 𝔉 r' u' by (rule assms(2))
obtain f where f: "f : r' ↦⇩i⇩s⇩o⇘ℭ⇙ r"
and u': "ntcf_arrow u' =
umap_fo (Δ⇩C α 𝔍 ℭ) (cf_map 𝔉) r (ntcf_arrow u) r'⦇ArrVal⦈⦇f⦈"
by
(
elim u.Δ.cf_universal_arrow_fo_ex_is_arr_isomorphism[
OF u.cat_lim_ua_fo u'.cat_lim_ua_fo
]
)
from f have "f : r' ↦⇘ℭ⇙ r" by auto
from u' this have "u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f"
by
(
cs_prems
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_small_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros cat_small_cs_intros
)
with f that show ?thesis by simp
qed
lemma cat_lim_ex_is_arr_isomorphism':
assumes "u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
and "u' : r' <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : r' ↦⇩i⇩s⇩o⇘ℭ⇙ r"
and "⋀j. j ∈⇩∘ 𝔍⦇Obj⦈ ⟹ u'⦇NTMap⦈⦇j⦈ = u⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f"
proof-
interpret u: is_cat_limit α 𝔍 ℭ 𝔉 r u by (rule assms(1))
interpret u': is_cat_limit α 𝔍 ℭ 𝔉 r' u' by (rule assms(2))
from assms obtain f
where iso_f: "f : r' ↦⇩i⇩s⇩o⇘ℭ⇙ r" and u'_def: "u' = u ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f"
by (rule cat_lim_ex_is_arr_isomorphism)
then have f: "f : r' ↦⇘ℭ⇙ r" by auto
then have "u'⦇NTMap⦈⦇j⦈ = u⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f" if "j ∈⇩∘ 𝔍⦇Obj⦈" for j
by
(
intro u.helper_cat_cone_ntcf_vcomp_Comp[
OF u'.is_cat_cone_axioms f u'_def that
]
)
with iso_f that show ?thesis by simp
qed
lemma cat_colim_ex_is_arr_isomorphism:
assumes "u : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
and "u' : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r' : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : r ↦⇩i⇩s⇩o⇘ℭ⇙ r'" and "u' = ntcf_const 𝔍 ℭ f ∙⇩N⇩T⇩C⇩F u"
proof-
interpret u: is_cat_colimit α 𝔍 ℭ 𝔉 r u by (rule assms(1))
interpret u': is_cat_colimit α 𝔍 ℭ 𝔉 r' u' by (rule assms(2))
obtain f where f: "f : r' ↦⇩i⇩s⇩o⇘op_cat ℭ⇙ r"
and [cat_cs_simps]:
"op_ntcf u' = op_ntcf u ∙⇩N⇩T⇩C⇩F ntcf_const (op_cat 𝔍) (op_cat ℭ) f"
by
(
elim cat_lim_ex_is_arr_isomorphism[
OF u.is_cat_limit_op u'.is_cat_limit_op
]
)
from f have iso_f: "f : r ↦⇩i⇩s⇩o⇘ℭ⇙ r'" unfolding cat_op_simps by simp
then have f: "f : r ↦⇘ℭ⇙ r'" by auto
have "u' = ntcf_const 𝔍 ℭ f ∙⇩N⇩T⇩C⇩F u"
by (rule eq_op_ntcf_iff[THEN iffD1], insert f)
(cs_concl cs_intro: cat_cs_intros cs_simp: cat_cs_simps cat_op_simps)+
from iso_f this that show ?thesis by simp
qed
lemma cat_colim_ex_is_arr_isomorphism':
assumes "u : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
and "u' : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r' : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : r ↦⇩i⇩s⇩o⇘ℭ⇙ r'"
and "⋀j. j ∈⇩∘ 𝔍⦇Obj⦈ ⟹ u'⦇NTMap⦈⦇j⦈ = f ∘⇩A⇘ℭ⇙ u⦇NTMap⦈⦇j⦈"
proof-
interpret u: is_cat_colimit α 𝔍 ℭ 𝔉 r u by (rule assms(1))
interpret u': is_cat_colimit α 𝔍 ℭ 𝔉 r' u' by (rule assms(2))
from assms obtain f
where iso_f: "f : r ↦⇩i⇩s⇩o⇘ℭ⇙ r'" and u'_def: "u' = ntcf_const 𝔍 ℭ f ∙⇩N⇩T⇩C⇩F u"
by (rule cat_colim_ex_is_arr_isomorphism)
then have f: "f : r ↦⇘ℭ⇙ r'" by auto
then have "u'⦇NTMap⦈⦇j⦈ = f ∘⇩A⇘ℭ⇙ u⦇NTMap⦈⦇j⦈" if "j ∈⇩∘ 𝔍⦇Obj⦈" for j
by
(
intro u.helper_cat_cocone_ntcf_vcomp_Comp[
OF u'.is_cat_cocone_axioms f u'_def that
]
)
with iso_f that show ?thesis by simp
qed
subsection‹Finite limit and finite colimit›
locale is_cat_finite_limit = is_cat_limit α 𝔍 ℭ 𝔉 r u + finite_category α 𝔍
for α 𝔍 ℭ 𝔉 r u
syntax "_is_cat_finite_limit" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ <⇩C⇩F⇩.⇩l⇩i⇩m⇩.⇩f⇩i⇩n _ :/ _ ↦↦⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "u : r <⇩C⇩F⇩.⇩l⇩i⇩m⇩.⇩f⇩i⇩n 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_finite_limit α 𝔍 ℭ 𝔉 r u"
locale is_cat_finite_colimit = is_cat_colimit α 𝔍 ℭ 𝔉 r u + finite_category α 𝔍
for α 𝔍 ℭ 𝔉 r u
syntax "_is_cat_finite_colimit" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m⇩.⇩f⇩i⇩n _ :/ _ ↦↦⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "u : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m⇩.⇩f⇩i⇩n r : 𝔍 ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_finite_colimit α 𝔍 ℭ 𝔉 r u"
text‹Rules.›
lemma (in is_cat_finite_limit) is_cat_finite_limit_axioms'[cat_lim_cs_intros]:
assumes "α' = α" and "r' = r" and "𝔍' = 𝔍" and "ℭ' = ℭ" and "𝔉' = 𝔉"
shows "u : r' <⇩C⇩F⇩.⇩l⇩i⇩m⇩.⇩f⇩i⇩n 𝔉' : 𝔍' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_finite_limit_axioms)
mk_ide rf is_cat_finite_limit_def
|intro is_cat_finite_limitI|
|dest is_cat_finite_limitD[dest]|
|elim is_cat_finite_limitE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_finite_limitD
lemma (in is_cat_finite_colimit)
is_cat_finite_colimit_axioms'[cat_lim_cs_intros]:
assumes "α' = α" and "r' = r" and "𝔍' = 𝔍" and "ℭ' = ℭ" and "𝔉' = 𝔉"
shows "u : 𝔉' >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m⇩.⇩f⇩i⇩n r' : 𝔍' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_finite_colimit_axioms)
mk_ide rf is_cat_finite_colimit_def[unfolded is_cat_colimit_axioms_def]
|intro is_cat_finite_colimitI|
|dest is_cat_finite_colimitD[dest]|
|elim is_cat_finite_colimitE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_finite_colimitD
text‹Duality›
lemma (in is_cat_finite_limit) is_cat_finite_colimit_op:
"op_ntcf u : op_cf 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m⇩.⇩f⇩i⇩n r : op_cat 𝔍 ↦↦⇩C⇘α⇙ op_cat ℭ"
by
(
cs_concl cs_intro:
is_cat_finite_colimitI cat_op_intros cat_small_cs_intros
)
lemma (in is_cat_finite_limit) is_cat_finite_colimit_op'[cat_op_intros]:
assumes "𝔉' = op_cf 𝔉" and "𝔍' = op_cat 𝔍" and "ℭ' = op_cat ℭ"
shows "op_ntcf u : 𝔉' >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m⇩.⇩f⇩i⇩n r : 𝔍' ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_finite_colimit_op)
lemmas [cat_op_intros] = is_cat_finite_limit.is_cat_finite_colimit_op'
lemma (in is_cat_finite_colimit) is_cat_finite_limit_op:
"op_ntcf u : r <⇩C⇩F⇩.⇩l⇩i⇩m⇩.⇩f⇩i⇩n op_cf 𝔉 : op_cat 𝔍 ↦↦⇩C⇘α⇙ op_cat ℭ"
by
(
cs_concl cs_intro:
is_cat_finite_limitI cat_op_intros cat_small_cs_intros
)
lemma (in is_cat_finite_colimit) is_cat_finite_colimit_op'[cat_op_intros]:
assumes "𝔉' = op_cf 𝔉" and "𝔍' = op_cat 𝔍" and "ℭ' = op_cat ℭ"
shows "op_ntcf u : r <⇩C⇩F⇩.⇩l⇩i⇩m⇩.⇩f⇩i⇩n 𝔉' : 𝔍' ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_finite_limit_op)
lemmas [cat_op_intros] = is_cat_finite_colimit.is_cat_finite_colimit_op'
subsection‹Product and coproduct›
subsubsection‹Definition and elementary properties›
text‹
The definition of the product object is a specialization of the
definition presented in Chapter III-4 in \cite{mac_lane_categories_2010}.
In the definition presented below, the discrete category that is used in the
definition presented in \cite{mac_lane_categories_2010} is parameterized by
an index set and the functor from the discrete category is
parameterized by a function from the index set to the set of
the objects of the category.
›
locale is_cat_obj_prod =
is_cat_limit α ‹:⇩C I› ℭ ‹:→: I A ℭ› P π + cf_discrete α I A ℭ
for α I A ℭ P π
syntax "_is_cat_obj_prod" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ <⇩C⇩F⇩.⇩∏ _ :/ _ ↦↦⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "π : P <⇩C⇩F⇩.⇩∏ A : I ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_obj_prod α I A ℭ P π"
locale is_cat_obj_coprod =
is_cat_colimit α ‹:⇩C I› ℭ ‹:→: I A ℭ› U π + cf_discrete α I A ℭ
for α I A ℭ U π
syntax "_is_cat_obj_coprod" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ >⇩C⇩F⇩.⇩∐ _ :/ _ ↦↦⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "π : A >⇩C⇩F⇩.⇩∐ U : I ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_obj_coprod α I A ℭ U π"
text‹Rules.›
lemma (in is_cat_obj_prod) is_cat_obj_prod_axioms'[cat_lim_cs_intros]:
assumes "α' = α" and "P' = P" and "A' = A" and "I' = I" and "ℭ' = ℭ"
shows "π : P' <⇩C⇩F⇩.⇩∏ A' : I' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_obj_prod_axioms)
mk_ide rf is_cat_obj_prod_def
|intro is_cat_obj_prodI|
|dest is_cat_obj_prodD[dest]|
|elim is_cat_obj_prodE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_obj_prodD
lemma (in is_cat_obj_coprod) is_cat_obj_coprod_axioms'[cat_lim_cs_intros]:
assumes "α' = α" and "U' = U" and "A' = A" and "I' = I" and "ℭ' = ℭ"
shows "π : A' >⇩C⇩F⇩.⇩∐ U' : I' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_obj_coprod_axioms)
mk_ide rf is_cat_obj_coprod_def
|intro is_cat_obj_coprodI|
|dest is_cat_obj_coprodD[dest]|
|elim is_cat_obj_coprodE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_obj_coprodD
text‹Duality.›
lemma (in is_cat_obj_prod) is_cat_obj_coprod_op:
"op_ntcf π : A >⇩C⇩F⇩.⇩∐ P : I ↦↦⇩C⇘α⇙ op_cat ℭ"
using cf_discrete_vdomain_vsubset_Vset
by (intro is_cat_obj_coprodI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
lemma (in is_cat_obj_prod) is_cat_obj_coprod_op'[cat_op_intros]:
assumes "ℭ' = op_cat ℭ"
shows "op_ntcf π : A >⇩C⇩F⇩.⇩∐ P : I ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_obj_coprod_op)
lemmas [cat_op_intros] = is_cat_obj_prod.is_cat_obj_coprod_op'
lemma (in is_cat_obj_coprod) is_cat_obj_prod_op:
"op_ntcf π : U <⇩C⇩F⇩.⇩∏ A : I ↦↦⇩C⇘α⇙ op_cat ℭ"
using cf_discrete_vdomain_vsubset_Vset
by (intro is_cat_obj_prodI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros)
lemma (in is_cat_obj_coprod) is_cat_obj_prod_op'[cat_op_intros]:
assumes "ℭ' = op_cat ℭ"
shows "op_ntcf π : U <⇩C⇩F⇩.⇩∏ A : I ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_obj_prod_op)
lemmas [cat_op_intros] = is_cat_obj_coprod.is_cat_obj_prod_op'
subsubsection‹Universal property›
lemma (in is_cat_obj_prod) cat_obj_prod_unique_cone':
assumes "π' : P' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e :→: I A ℭ : :⇩C I ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : P' ↦⇘ℭ⇙ P ∧ (∀j∈⇩∘I. π'⦇NTMap⦈⦇j⦈ = π⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f')"
by
(
rule cat_lim_unique_cone'[
OF assms, unfolded the_cat_discrete_components(1)
]
)
lemma (in is_cat_obj_prod) cat_obj_prod_unique:
assumes "π' : P' <⇩C⇩F⇩.⇩∏ A : I ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : P' ↦⇘ℭ⇙ P ∧ π' = π ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C I) ℭ f'"
by (intro cat_lim_unique[OF is_cat_obj_prodD(1)[OF assms]])
lemma (in is_cat_obj_prod) cat_obj_prod_unique':
assumes "π' : P' <⇩C⇩F⇩.⇩∏ A : I ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : P' ↦⇘ℭ⇙ P ∧ (∀i∈⇩∘I. π'⦇NTMap⦈⦇i⦈ = π⦇NTMap⦈⦇i⦈ ∘⇩A⇘ℭ⇙ f')"
proof-
interpret π': is_cat_obj_prod α I A ℭ P' π' by (rule assms(1))
show ?thesis
by
(
rule cat_lim_unique'[
OF π'.is_cat_limit_axioms, unfolded the_cat_discrete_components(1)
]
)
qed
lemma (in is_cat_obj_coprod) cat_obj_coprod_unique_cocone':
assumes "π' : :→: I A ℭ >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e U' : :⇩C I ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : U ↦⇘ℭ⇙ U' ∧ (∀j∈⇩∘I. π'⦇NTMap⦈⦇j⦈ = f' ∘⇩A⇘ℭ⇙ π⦇NTMap⦈⦇j⦈)"
by
(
rule cat_colim_unique_cocone'[
OF assms, unfolded the_cat_discrete_components(1)
]
)
lemma (in is_cat_obj_coprod) cat_obj_coprod_unique:
assumes "π' : A >⇩C⇩F⇩.⇩∐ U' : I ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : U ↦⇘ℭ⇙ U' ∧ π' = ntcf_const (:⇩C I) ℭ f' ∙⇩N⇩T⇩C⇩F π"
by (intro cat_colim_unique[OF is_cat_obj_coprodD(1)[OF assms]])
lemma (in is_cat_obj_coprod) cat_obj_coprod_unique':
assumes "π' : A >⇩C⇩F⇩.⇩∐ U' : I ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : U ↦⇘ℭ⇙ U' ∧ (∀j∈⇩∘I. π'⦇NTMap⦈⦇j⦈ = f' ∘⇩A⇘ℭ⇙ π⦇NTMap⦈⦇j⦈)"
by
(
rule cat_colim_unique'[
OF is_cat_obj_coprodD(1)[OF assms], unfolded the_cat_discrete_components
]
)
lemma cat_obj_prod_ex_is_arr_isomorphism:
assumes "π : P <⇩C⇩F⇩.⇩∏ A : I ↦↦⇩C⇘α⇙ ℭ" and "π' : P' <⇩C⇩F⇩.⇩∏ A : I ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : P' ↦⇩i⇩s⇩o⇘ℭ⇙ P" and "π' = π ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C I) ℭ f"
proof-
interpret π: is_cat_obj_prod α I A ℭ P π by (rule assms(1))
interpret π': is_cat_obj_prod α I A ℭ P' π' by (rule assms(2))
from that show ?thesis
by
(
elim cat_lim_ex_is_arr_isomorphism[
OF π.is_cat_limit_axioms π'.is_cat_limit_axioms
]
)
qed
lemma cat_obj_prod_ex_is_arr_isomorphism':
assumes "π : P <⇩C⇩F⇩.⇩∏ A : I ↦↦⇩C⇘α⇙ ℭ" and "π' : P' <⇩C⇩F⇩.⇩∏ A : I ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : P' ↦⇩i⇩s⇩o⇘ℭ⇙ P"
and "⋀j. j ∈⇩∘ I ⟹ π'⦇NTMap⦈⦇j⦈ = π⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f"
proof-
interpret π: is_cat_obj_prod α I A ℭ P π by (rule assms(1))
interpret π': is_cat_obj_prod α I A ℭ P' π' by (rule assms(2))
from that show ?thesis
by
(
elim cat_lim_ex_is_arr_isomorphism'[
OF π.is_cat_limit_axioms π'.is_cat_limit_axioms,
unfolded the_cat_discrete_components(1)
]
)
qed
lemma cat_obj_coprod_ex_is_arr_isomorphism:
assumes "π : A >⇩C⇩F⇩.⇩∐ U : I ↦↦⇩C⇘α⇙ ℭ" and "π' : A >⇩C⇩F⇩.⇩∐ U' : I ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : U ↦⇩i⇩s⇩o⇘ℭ⇙ U'" and "π' = ntcf_const (:⇩C I) ℭ f ∙⇩N⇩T⇩C⇩F π"
proof-
interpret π: is_cat_obj_coprod α I A ℭ U π by (rule assms(1))
interpret π': is_cat_obj_coprod α I A ℭ U' π' by (rule assms(2))
from that show ?thesis
by
(
elim cat_colim_ex_is_arr_isomorphism[
OF π.is_cat_colimit_axioms π'.is_cat_colimit_axioms
]
)
qed
lemma cat_obj_coprod_ex_is_arr_isomorphism':
assumes "π : A >⇩C⇩F⇩.⇩∐ U : I ↦↦⇩C⇘α⇙ ℭ" and "π' : A >⇩C⇩F⇩.⇩∐ U' : I ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : U ↦⇩i⇩s⇩o⇘ℭ⇙ U'"
and "⋀j. j ∈⇩∘ I ⟹ π'⦇NTMap⦈⦇j⦈ = f ∘⇩A⇘ℭ⇙ π⦇NTMap⦈⦇j⦈"
proof-
interpret π: is_cat_obj_coprod α I A ℭ U π by (rule assms(1))
interpret π': is_cat_obj_coprod α I A ℭ U' π' by (rule assms(2))
from that show ?thesis
by
(
elim cat_colim_ex_is_arr_isomorphism'[
OF π.is_cat_colimit_axioms π'.is_cat_colimit_axioms,
unfolded the_cat_discrete_components(1)
]
)
qed
subsection‹Finite product and finite coproduct›
locale is_cat_finite_obj_prod = is_cat_obj_prod α I A ℭ P π
for α I A ℭ P π +
assumes cat_fin_obj_prod_index_in_ω: "I ∈⇩∘ ω"
syntax "_is_cat_finite_obj_prod" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ <⇩C⇩F⇩.⇩∏⇩.⇩f⇩i⇩n _ :/ _ ↦↦⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "π : P <⇩C⇩F⇩.⇩∏⇩.⇩f⇩i⇩n A : I ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_finite_obj_prod α I A ℭ P π"
locale is_cat_finite_obj_coprod = is_cat_obj_coprod α I A ℭ U π
for α I A ℭ U π +
assumes cat_fin_obj_coprod_index_in_ω: "I ∈⇩∘ ω"
syntax "_is_cat_finite_obj_coprod" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ >⇩C⇩F⇩.⇩∐⇩.⇩f⇩i⇩n _ :/ _ ↦↦⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "π : A >⇩C⇩F⇩.⇩∐⇩.⇩f⇩i⇩n U : I ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_finite_obj_coprod α I A ℭ U π"
lemma (in is_cat_finite_obj_prod) cat_fin_obj_prod_index_vfinite: "vfinite I"
using cat_fin_obj_prod_index_in_ω by auto
sublocale is_cat_finite_obj_prod ⊆ I: finite_category α ‹:⇩C I›
by (intro finite_categoryI')
(
auto
simp: NTDom.HomDom.tiny_dg_category the_cat_discrete_components
intro!: cat_fin_obj_prod_index_vfinite
)
lemma (in is_cat_finite_obj_coprod) cat_fin_obj_coprod_index_vfinite:
"vfinite I"
using cat_fin_obj_coprod_index_in_ω by auto
sublocale is_cat_finite_obj_coprod ⊆ I: finite_category α ‹:⇩C I›
by (intro finite_categoryI')
(
auto
simp: NTDom.HomDom.tiny_dg_category the_cat_discrete_components
intro!: cat_fin_obj_coprod_index_vfinite
)
text‹Rules.›
lemma (in is_cat_finite_obj_prod)
is_cat_finite_obj_prod_axioms'[cat_lim_cs_intros]:
assumes "α' = α" and "P' = P" and "A' = A" and "I' = I" and "ℭ' = ℭ"
shows "π : P' <⇩C⇩F⇩.⇩∏⇩.⇩f⇩i⇩n A' : I' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_finite_obj_prod_axioms)
mk_ide rf
is_cat_finite_obj_prod_def[unfolded is_cat_finite_obj_prod_axioms_def]
|intro is_cat_finite_obj_prodI|
|dest is_cat_finite_obj_prodD[dest]|
|elim is_cat_finite_obj_prodE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_finite_obj_prodD
lemma (in is_cat_finite_obj_coprod)
is_cat_finite_obj_coprod_axioms'[cat_lim_cs_intros]:
assumes "α' = α" and "U' = U" and "A' = A" and "I' = I" and "ℭ' = ℭ"
shows "π : A' >⇩C⇩F⇩.⇩∐⇩.⇩f⇩i⇩n U' : I' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_finite_obj_coprod_axioms)
mk_ide rf
is_cat_finite_obj_coprod_def[unfolded is_cat_finite_obj_coprod_axioms_def]
|intro is_cat_finite_obj_coprodI|
|dest is_cat_finite_obj_coprodD[dest]|
|elim is_cat_finite_obj_coprodE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_finite_obj_coprodD
text‹Duality.›
lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op:
"op_ntcf π : A >⇩C⇩F⇩.⇩∐⇩.⇩f⇩i⇩n P : I ↦↦⇩C⇘α⇙ op_cat ℭ"
by (intro is_cat_finite_obj_coprodI)
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_fin_obj_prod_index_in_ω cat_cs_intros cat_op_intros
)
lemma (in is_cat_finite_obj_prod) is_cat_finite_obj_coprod_op'[cat_op_intros]:
assumes "ℭ' = op_cat ℭ"
shows "op_ntcf π : A >⇩C⇩F⇩.⇩∐⇩.⇩f⇩i⇩n P : I ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_finite_obj_coprod_op)
lemmas [cat_op_intros] = is_cat_finite_obj_prod.is_cat_finite_obj_coprod_op'
lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op:
"op_ntcf π : U <⇩C⇩F⇩.⇩∏⇩.⇩f⇩i⇩n A : I ↦↦⇩C⇘α⇙ op_cat ℭ"
by (intro is_cat_finite_obj_prodI)
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_fin_obj_coprod_index_in_ω cat_cs_intros cat_op_intros
)
lemma (in is_cat_finite_obj_coprod) is_cat_finite_obj_prod_op'[cat_op_intros]:
assumes "ℭ' = op_cat ℭ"
shows "op_ntcf π : U <⇩C⇩F⇩.⇩∏⇩.⇩f⇩i⇩n A : I ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_finite_obj_prod_op)
lemmas [cat_op_intros] = is_cat_finite_obj_coprod.is_cat_finite_obj_prod_op'
subsection‹Product and coproduct of two objects›
subsubsection‹Definition and elementary properties›
locale is_cat_obj_prod_2 = is_cat_obj_prod α ‹2⇩ℕ› ‹if2 a b› ℭ P π
for α a b ℭ P π
syntax "_is_cat_obj_prod_2" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ <⇩C⇩F⇩.⇩× {_,_} :/ 2⇩C ↦↦⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "π : P <⇩C⇩F⇩.⇩× {a,b} : 2⇩C ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_obj_prod_2 α a b ℭ P π"
locale is_cat_obj_coprod_2 = is_cat_obj_coprod α ‹2⇩ℕ› ‹if2 a b› ℭ P π
for α a b ℭ P π
syntax "_is_cat_obj_coprod_2" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ {_,_} >⇩C⇩F⇩.⇩⊎ _ :/ 2⇩C ↦↦⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "π : {a,b} >⇩C⇩F⇩.⇩⊎ U : 2⇩C ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_obj_coprod_2 α a b ℭ U π"
abbreviation proj_fst where "proj_fst π ≡ vpfst (π⦇NTMap⦈)"
abbreviation proj_snd where "proj_snd π ≡ vpsnd (π⦇NTMap⦈)"
text‹Rules.›
lemma (in is_cat_obj_prod_2) is_cat_obj_prod_2_axioms'[cat_lim_cs_intros]:
assumes "α' = α" and "P' = P" and "a' = a" and "b' = b" and "ℭ' = ℭ"
shows "π : P' <⇩C⇩F⇩.⇩× {a',b'} : 2⇩C ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_obj_prod_2_axioms)
mk_ide rf is_cat_obj_prod_2_def
|intro is_cat_obj_prod_2I|
|dest is_cat_obj_prod_2D[dest]|
|elim is_cat_obj_prod_2E[elim]|
lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2D
lemma (in is_cat_obj_coprod_2) is_cat_obj_coprod_2_axioms'[cat_lim_cs_intros]:
assumes "α' = α" and "P' = P" and "a' = a" and "b' = b" and "ℭ' = ℭ"
shows "π : {a',b'} >⇩C⇩F⇩.⇩⊎ P' : 2⇩C ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_obj_coprod_2_axioms)
mk_ide rf is_cat_obj_coprod_2_def
|intro is_cat_obj_coprod_2I|
|dest is_cat_obj_coprod_2D[dest]|
|elim is_cat_obj_coprod_2E[elim]|
lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2D
text‹Duality.›
lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op:
"op_ntcf π : {a,b} >⇩C⇩F⇩.⇩⊎ P : 2⇩C ↦↦⇩C⇘α⇙ op_cat ℭ"
by (rule is_cat_obj_coprod_2I[OF is_cat_obj_coprod_op])
lemma (in is_cat_obj_prod_2) is_cat_obj_coprod_2_op'[cat_op_intros]:
assumes "ℭ' = op_cat ℭ"
shows "op_ntcf π : {a,b} >⇩C⇩F⇩.⇩⊎ P : 2⇩C ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_obj_coprod_2_op)
lemmas [cat_op_intros] = is_cat_obj_prod_2.is_cat_obj_coprod_2_op'
lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op:
"op_ntcf π : P <⇩C⇩F⇩.⇩× {a,b} : 2⇩C ↦↦⇩C⇘α⇙ op_cat ℭ"
by (rule is_cat_obj_prod_2I[OF is_cat_obj_prod_op])
lemma (in is_cat_obj_coprod_2) is_cat_obj_prod_2_op'[cat_op_intros]:
assumes "ℭ' = op_cat ℭ"
shows "op_ntcf π : P <⇩C⇩F⇩.⇩× {a,b} : 2⇩C ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_obj_prod_2_op)
lemmas [cat_op_intros] = is_cat_obj_coprod_2.is_cat_obj_prod_2_op'
text‹Product/coproduct of two objects is a finite product/coproduct.›
sublocale is_cat_obj_prod_2 ⊆ is_cat_finite_obj_prod α ‹2⇩ℕ› ‹if2 a b› ℭ P π
proof(intro is_cat_finite_obj_prodI)
show "2⇩ℕ ∈⇩∘ ω" by simp
qed (cs_concl cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)
sublocale is_cat_obj_coprod_2 ⊆ is_cat_finite_obj_coprod α ‹2⇩ℕ› ‹if2 a b› ℭ P π
proof(intro is_cat_finite_obj_coprodI)
show "2⇩ℕ ∈⇩∘ ω" by simp
qed (cs_concl cs_simp: two[symmetric] cs_intro: cat_lim_cs_intros)
text‹Elementary properties.›
lemma (in is_cat_obj_prod_2) cat_obj_prod_2_lr_in_Obj:
shows cat_obj_prod_2_left_in_Obj[cat_lim_cs_intros]: "a ∈⇩∘ ℭ⦇Obj⦈"
and cat_obj_prod_2_right_in_Obj[cat_lim_cs_intros]: "b ∈⇩∘ ℭ⦇Obj⦈"
proof-
have 0: "0 ∈⇩∘ 2⇩ℕ" and 1: "1⇩ℕ ∈⇩∘ 2⇩ℕ" by simp_all
show "a ∈⇩∘ ℭ⦇Obj⦈" and "b ∈⇩∘ ℭ⦇Obj⦈"
by
(
intro
cf_discrete_selector_vrange[OF 0, simplified]
cf_discrete_selector_vrange[OF 1, simplified]
)+
qed
lemmas [cat_lim_cs_intros] = is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj
lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_lr_in_Obj:
shows cat_obj_coprod_2_left_in_Obj[cat_lim_cs_intros]: "a ∈⇩∘ ℭ⦇Obj⦈"
and cat_obj_coprod_2_right_in_Obj[cat_lim_cs_intros]: "b ∈⇩∘ ℭ⦇Obj⦈"
by
(
intro is_cat_obj_prod_2.cat_obj_prod_2_lr_in_Obj[
OF is_cat_obj_prod_2_op, unfolded cat_op_simps
]
)+
lemmas [cat_lim_cs_intros] = is_cat_obj_coprod_2.cat_obj_coprod_2_lr_in_Obj
text‹Utilities/help lemmas.›
lemma helper_I2_proj_fst_proj_snd_iff:
"(∀j∈⇩∘2⇩ℕ. π'⦇NTMap⦈⦇j⦈ = π⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f') ⟷
(proj_fst π' = proj_fst π ∘⇩A⇘ℭ⇙ f' ∧ proj_snd π' = proj_snd π ∘⇩A⇘ℭ⇙ f')"
unfolding two by auto
lemma helper_I2_proj_fst_proj_snd_iff':
"(∀j∈⇩∘2⇩ℕ. π'⦇NTMap⦈⦇j⦈ = f' ∘⇩A⇘ℭ⇙ π⦇NTMap⦈⦇j⦈) ⟷
(proj_fst π' = f' ∘⇩A⇘ℭ⇙ proj_fst π ∧ proj_snd π' = f' ∘⇩A⇘ℭ⇙ proj_snd π)"
unfolding two by auto
subsubsection‹Universal property›
lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique_cone':
assumes "π' : P' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e :→: (2⇩ℕ) (if2 a b) ℭ : :⇩C (2⇩ℕ) ↦↦⇩C⇘α⇙ ℭ"
shows
"∃!f'. f' : P' ↦⇘ℭ⇙ P ∧
proj_fst π' = proj_fst π ∘⇩A⇘ℭ⇙ f' ∧
proj_snd π' = proj_snd π ∘⇩A⇘ℭ⇙ f'"
by
(
rule cat_obj_prod_unique_cone'[
OF assms, unfolded helper_I2_proj_fst_proj_snd_iff
]
)
lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique:
assumes "π' : P' <⇩C⇩F⇩.⇩× {a,b} : 2⇩C ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : P' ↦⇘ℭ⇙ P ∧ π' = π ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C (2⇩ℕ)) ℭ f'"
by (rule cat_obj_prod_unique[OF is_cat_obj_prod_2D[OF assms]])
lemma (in is_cat_obj_prod_2) cat_obj_prod_2_unique':
assumes "π' : P' <⇩C⇩F⇩.⇩× {a,b} : 2⇩C ↦↦⇩C⇘α⇙ ℭ"
shows
"∃!f'. f' : P' ↦⇘ℭ⇙ P ∧
proj_fst π' = proj_fst π ∘⇩A⇘ℭ⇙ f' ∧
proj_snd π' = proj_snd π ∘⇩A⇘ℭ⇙ f'"
by
(
rule cat_obj_prod_unique'[
OF is_cat_obj_prod_2D[OF assms],
unfolded helper_I2_proj_fst_proj_snd_iff
]
)
lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique_cocone':
assumes "π' : :→: (2⇩ℕ) (if2 a b) ℭ >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e P' : :⇩C (2⇩ℕ) ↦↦⇩C⇘α⇙ ℭ"
shows
"∃!f'. f' : P ↦⇘ℭ⇙ P' ∧
proj_fst π' = f' ∘⇩A⇘ℭ⇙ proj_fst π ∧
proj_snd π' = f' ∘⇩A⇘ℭ⇙ proj_snd π"
by
(
rule cat_obj_coprod_unique_cocone'[
OF assms, unfolded helper_I2_proj_fst_proj_snd_iff'
]
)
lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique:
assumes "π' : {a,b} >⇩C⇩F⇩.⇩⊎ P' : 2⇩C ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : P ↦⇘ℭ⇙ P' ∧ π' = ntcf_const (:⇩C (2⇩ℕ)) ℭ f' ∙⇩N⇩T⇩C⇩F π"
by (rule cat_obj_coprod_unique[OF is_cat_obj_coprod_2D[OF assms]])
lemma (in is_cat_obj_coprod_2) cat_obj_coprod_2_unique':
assumes "π' : {a,b} >⇩C⇩F⇩.⇩⊎ P' : 2⇩C ↦↦⇩C⇘α⇙ ℭ"
shows
"∃!f'. f' : P ↦⇘ℭ⇙ P' ∧
proj_fst π' = f' ∘⇩A⇘ℭ⇙ proj_fst π ∧
proj_snd π' = f' ∘⇩A⇘ℭ⇙ proj_snd π"
by
(
rule cat_obj_coprod_unique'[
OF is_cat_obj_coprod_2D[OF assms],
unfolded helper_I2_proj_fst_proj_snd_iff'
]
)
lemma cat_obj_prod_2_ex_is_arr_isomorphism:
assumes "π : P <⇩C⇩F⇩.⇩× {a,b} : 2⇩C ↦↦⇩C⇘α⇙ ℭ"
and "π' : P' <⇩C⇩F⇩.⇩× {a,b} : 2⇩C ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : P' ↦⇩i⇩s⇩o⇘ℭ⇙ P" and "π' = π ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C (2⇩ℕ)) ℭ f"
proof-
interpret π: is_cat_obj_prod_2 α a b ℭ P π by (rule assms(1))
interpret π': is_cat_obj_prod_2 α a b ℭ P' π' by (rule assms(2))
from that show ?thesis
by
(
elim cat_obj_prod_ex_is_arr_isomorphism[
OF π.is_cat_obj_prod_axioms π'.is_cat_obj_prod_axioms
]
)
qed
lemma cat_obj_coprod_2_ex_is_arr_isomorphism:
assumes "π : {a,b} >⇩C⇩F⇩.⇩⊎ U : 2⇩C ↦↦⇩C⇘α⇙ ℭ"
and "π' : {a,b} >⇩C⇩F⇩.⇩⊎ U' : 2⇩C ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : U ↦⇩i⇩s⇩o⇘ℭ⇙ U'" and "π' = ntcf_const (:⇩C (2⇩ℕ)) ℭ f ∙⇩N⇩T⇩C⇩F π"
proof-
interpret π: is_cat_obj_coprod_2 α a b ℭ U π by (rule assms(1))
interpret π': is_cat_obj_coprod_2 α a b ℭ U' π' by (rule assms(2))
from that show ?thesis
by
(
elim cat_obj_coprod_ex_is_arr_isomorphism[
OF π.is_cat_obj_coprod_axioms π'.is_cat_obj_coprod_axioms
]
)
qed
subsection‹Pullbacks and pushouts›
subsubsection‹Definition and elementary properties›
text‹
The definitions and the elementary properties of the pullbacks and the
pushouts can be found, for example, in Chapter III-3 and Chapter III-4 in
\cite{mac_lane_categories_2010}.
›
locale is_cat_pullback =
is_cat_limit α ‹→∙←⇩C› ℭ ‹⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙› X x +
cf_scospan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ
for α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x
syntax "_is_cat_pullback" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ <⇩C⇩F⇩.⇩p⇩b _→_→_←_←_ ↦↦⇩Cı _)› [51, 51, 51, 51, 51, 51, 51, 51] 51)
translations "x : X <⇩C⇩F⇩.⇩p⇩b 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x"
locale is_cat_pushout =
is_cat_colimit α ‹←∙→⇩C› ℭ ‹⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩⇩C⇩F⇘ℭ⇙› X x +
cf_sspan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ
for α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x
syntax "_is_cat_pushout" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _←_←_→_→_ >⇩C⇩F⇩.⇩p⇩o _ ↦↦⇩Cı _)› [51, 51, 51, 51, 51, 51, 51, 51] 51)
translations "x : 𝔞←𝔤←𝔬→𝔣→𝔟 >⇩C⇩F⇩.⇩p⇩o X ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_pushout α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x"
text‹Rules.›
lemma (in is_cat_pullback) is_cat_pullback_axioms'[cat_lim_cs_intros]:
assumes "α' = α"
and "𝔞' = 𝔞"
and "𝔤' = 𝔤"
and "𝔬' = 𝔬"
and "𝔣' = 𝔣"
and "𝔟' = 𝔟"
and "ℭ' = ℭ"
and "X' = X"
shows "x : X' <⇩C⇩F⇩.⇩p⇩b 𝔞'→𝔤'→𝔬'←𝔣'←𝔟' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_pullback_axioms)
mk_ide rf is_cat_pullback_def
|intro is_cat_pullbackI|
|dest is_cat_pullbackD[dest]|
|elim is_cat_pullbackE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_pullbackD
lemma (in is_cat_pushout) is_cat_pushout_axioms'[cat_lim_cs_intros]:
assumes "α' = α"
and "𝔞' = 𝔞"
and "𝔤' = 𝔤"
and "𝔬' = 𝔬"
and "𝔣' = 𝔣"
and "𝔟' = 𝔟"
and "ℭ' = ℭ"
and "X' = X"
shows "x : 𝔞'←𝔤'←𝔬'→𝔣'→𝔟' >⇩C⇩F⇩.⇩p⇩o X' ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_pushout_axioms)
mk_ide rf is_cat_pushout_def
|intro is_cat_pushoutI|
|dest is_cat_pushoutD[dest]|
|elim is_cat_pushoutE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_pushoutD
text‹Duality.›
lemma (in is_cat_pullback) is_cat_pushout_op:
"op_ntcf x : 𝔞←𝔤←𝔬→𝔣→𝔟 >⇩C⇩F⇩.⇩p⇩o X ↦↦⇩C⇘α⇙ op_cat ℭ"
by (intro is_cat_pushoutI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
lemma (in is_cat_pullback) is_cat_pushout_op'[cat_op_intros]:
assumes "ℭ' = op_cat ℭ"
shows "op_ntcf x : 𝔞←𝔤←𝔬→𝔣→𝔟 >⇩C⇩F⇩.⇩p⇩o X ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_pushout_op)
lemmas [cat_op_intros] = is_cat_pullback.is_cat_pushout_op'
lemma (in is_cat_pushout) is_cat_pullback_op:
"op_ntcf x : X <⇩C⇩F⇩.⇩p⇩b 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦⇩C⇘α⇙ op_cat ℭ"
by (intro is_cat_pullbackI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
lemma (in is_cat_pushout) is_cat_pullback_op'[cat_op_intros]:
assumes "ℭ' = op_cat ℭ"
shows "op_ntcf x : X <⇩C⇩F⇩.⇩p⇩b 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_pullback_op)
lemmas [cat_op_intros] = is_cat_pushout.is_cat_pullback_op'
text‹Elementary properties.›
lemma cat_cone_cospan:
assumes "x : X <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙ : →∙←⇩C ↦↦⇩C⇘α⇙ ℭ"
and "cf_scospan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ"
shows "x⦇NTMap⦈⦇𝔬⇩S⇩S⦈ = 𝔤 ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈"
and "x⦇NTMap⦈⦇𝔬⇩S⇩S⦈ = 𝔣 ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈"
and "𝔤 ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = 𝔣 ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈"
proof-
interpret x: is_cat_cone α X ‹→∙←⇩C› ℭ ‹⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙› x
by (rule assms(1))
interpret cospan: cf_scospan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ by (rule assms(2))
have 𝔤⇩S⇩S: "𝔤⇩S⇩S : 𝔞⇩S⇩S ↦⇘→∙←⇩C⇙ 𝔬⇩S⇩S" and 𝔣⇩S⇩S: "𝔣⇩S⇩S : 𝔟⇩S⇩S ↦⇘→∙←⇩C⇙ 𝔬⇩S⇩S"
by (cs_concl cs_simp: cs_intro: cat_ss_cs_intros)+
from x.ntcf_Comp_commute[OF 𝔤⇩S⇩S] 𝔤⇩S⇩S 𝔣⇩S⇩S show
"x⦇NTMap⦈⦇𝔬⇩S⇩S⦈ = 𝔤 ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈"
by (cs_prems cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
moreover from x.ntcf_Comp_commute[OF 𝔣⇩S⇩S] 𝔤⇩S⇩S 𝔣⇩S⇩S show
"x⦇NTMap⦈⦇𝔬⇩S⇩S⦈ = 𝔣 ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈"
by (cs_prems cs_simp: cat_ss_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
ultimately show "𝔤 ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = 𝔣 ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈" by simp
qed
lemma (in is_cat_pullback) cat_pb_cone_cospan:
shows "x⦇NTMap⦈⦇𝔬⇩S⇩S⦈ = 𝔤 ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈"
and "x⦇NTMap⦈⦇𝔬⇩S⇩S⦈ = 𝔣 ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈"
and "𝔤 ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = 𝔣 ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈"
by (all‹rule cat_cone_cospan[OF is_cat_cone_axioms cf_scospan_axioms]›)
lemma cat_cocone_span:
assumes "x : ⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩⇩C⇩F⇘ℭ⇙ >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e X : ←∙→⇩C ↦↦⇩C⇘α⇙ ℭ"
and "cf_sspan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ"
shows "x⦇NTMap⦈⦇𝔬⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ 𝔤"
and "x⦇NTMap⦈⦇𝔬⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ 𝔣"
and "x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ 𝔤 = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ 𝔣"
proof-
interpret x: is_cat_cocone α X ‹←∙→⇩C› ℭ ‹⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩⇩C⇩F⇘ℭ⇙› x
by (rule assms(1))
interpret span: cf_sspan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ by (rule assms(2))
note op =
cat_cone_cospan
[
OF
x.is_cat_cone_op[unfolded cat_op_simps]
span.cf_scospan_op,
unfolded cat_op_simps
]
from op(1) show "x⦇NTMap⦈⦇𝔬⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ 𝔤"
by
(
cs_prems
cs_simp: cat_ss_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_ss_cs_intros
)
moreover from op(2) show "x⦇NTMap⦈⦇𝔬⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ 𝔣"
by
(
cs_prems
cs_simp: cat_ss_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_ss_cs_intros
)
ultimately show "x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ 𝔤 = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ 𝔣" by auto
qed
lemma (in is_cat_pushout) cat_po_cocone_span:
shows "x⦇NTMap⦈⦇𝔬⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ 𝔤"
and "x⦇NTMap⦈⦇𝔬⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ 𝔣"
and "x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ 𝔤 = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ 𝔣"
by (all‹rule cat_cocone_span[OF is_cat_cocone_axioms cf_sspan_axioms]›)
subsubsection‹Universal property›
lemma is_cat_pullbackI':
assumes "x : X <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙ : →∙←⇩C ↦↦⇩C⇘α⇙ ℭ"
and "cf_scospan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ"
and "⋀x' X'.
x' : X' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙ : →∙←⇩C ↦↦⇩C⇘α⇙ ℭ ⟹
∃!f'.
f' : X' ↦⇘ℭ⇙ X ∧
x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f' ∧
x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f'"
shows "x : X <⇩C⇩F⇩.⇩p⇩b 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦⇩C⇘α⇙ ℭ"
proof(intro is_cat_pullbackI is_cat_limitI')
show "x : X <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙ : →∙←⇩C ↦↦⇩C⇘α⇙ ℭ"
by (rule assms(1))
interpret x: is_cat_cone α X ‹→∙←⇩C› ℭ ‹⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙› x
by (rule assms(1))
show "cf_scospan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ" by (rule assms(2))
interpret cospan: cf_scospan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ by (rule assms(2))
fix u' r' assume prems:
"u' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙ : →∙←⇩C ↦↦⇩C⇘α⇙ ℭ"
interpret u': is_cat_cone α r' ‹→∙←⇩C› ℭ ‹⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙› u'
by (rule prems)
from assms(3)[OF prems] obtain f'
where f': "f' : r' ↦⇘ℭ⇙ X"
and u'_𝔞⇩S⇩S: "u'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f'"
and u'_𝔟⇩S⇩S: "u'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f'"
and unique_f': "⋀f''.
⟦
f'' : r' ↦⇘ℭ⇙ X;
u'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f'';
u'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f''
⟧ ⟹ f'' = f'"
by metis
show "∃!f'. f' : r' ↦⇘ℭ⇙ X ∧ u' = x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f'"
proof(intro ex1I conjI; (elim conjE)?)
show "u' = x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f'"
proof(rule ntcf_eqI)
show "u' : cf_const →∙←⇩C ℭ r' ↦⇩C⇩F ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙ : →∙←⇩C ↦↦⇩C⇘α⇙ ℭ"
by (rule u'.is_ntcf_axioms)
from f' show
"x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f' :
cf_const →∙←⇩C ℭ r' ↦⇩C⇩F ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙ :
→∙←⇩C ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from f' have dom_rhs:
"𝒟⇩∘ ((x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f')⦇NTMap⦈) = →∙←⇩C⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "u'⦇NTMap⦈ = (x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f')⦇NTMap⦈"
proof(rule vsv_eqI, unfold cat_cs_simps dom_rhs)
fix a assume prems': "a ∈⇩∘ →∙←⇩C⦇Obj⦈"
from this f' x.is_ntcf_axioms show
"u'⦇NTMap⦈⦇a⦈ = (x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f')⦇NTMap⦈⦇a⦈"
by (elim the_cat_scospan_ObjE; simp only:)
(
cs_concl
cs_simp:
cat_cs_simps cat_ss_cs_simps
u'_𝔟⇩S⇩S u'_𝔞⇩S⇩S
cat_cone_cospan(1)[OF assms(1,2)]
cat_cone_cospan(1)[OF prems assms(2)]
cs_intro: cat_cs_intros cat_ss_cs_intros
)+
qed (cs_concl cs_intro: cat_cs_intros | auto)+
qed simp_all
fix f'' assume prems:
"f'' : r' ↦⇘ℭ⇙ X" "u' = x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f''"
have 𝔞⇩S⇩S: "𝔞⇩S⇩S ∈⇩∘ →∙←⇩C⦇Obj⦈" and 𝔟⇩S⇩S: "𝔟⇩S⇩S ∈⇩∘ →∙←⇩C⦇Obj⦈"
by (cs_concl cs_simp: cs_intro: cat_ss_cs_intros)+
have "u'⦇NTMap⦈⦇a⦈ = x⦇NTMap⦈⦇a⦈ ∘⇩A⇘ℭ⇙ f''" if "a ∈⇩∘ →∙←⇩C⦇Obj⦈" for a
proof-
from prems(2) have
"u'⦇NTMap⦈⦇a⦈ = (x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f'')⦇NTMap⦈⦇a⦈"
by simp
from this that prems(1) show "u'⦇NTMap⦈⦇a⦈ = x⦇NTMap⦈⦇a⦈ ∘⇩A⇘ℭ⇙ f''"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
from unique_f'[OF prems(1) this[OF 𝔞⇩S⇩S] this[OF 𝔟⇩S⇩S]] show "f'' = f'".
qed (intro f')
qed
lemma is_cat_pushoutI':
assumes "x : ⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩⇩C⇩F⇘ℭ⇙ >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e X : ←∙→⇩C ↦↦⇩C⇘α⇙ ℭ"
and "cf_sspan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ"
and "⋀x' X'. x' : ⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩⇩C⇩F⇘ℭ⇙ >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e X' : ←∙→⇩C ↦↦⇩C⇘α⇙ ℭ ⟹
∃!f'.
f' : X ↦⇘ℭ⇙ X' ∧
x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = f' ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∧
x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = f' ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈"
shows "x : 𝔞←𝔤←𝔬→𝔣→𝔟 >⇩C⇩F⇩.⇩p⇩o X ↦↦⇩C⇘α⇙ ℭ"
proof-
interpret x: is_cat_cocone α X ‹←∙→⇩C› ℭ ‹⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩⇩C⇩F⇘ℭ⇙› x
by (rule assms(1))
interpret span: cf_sspan α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ by (rule assms(2))
have assms_3':
"∃!f'.
f' : X ↦⇘ℭ⇙ X' ∧
x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘op_cat ℭ⇙ f' ∧
x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘op_cat ℭ⇙ f'"
if "x' : X' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘op_cat ℭ⇙ : →∙←⇩C ↦↦⇩C⇘α⇙ op_cat ℭ"
for x' X'
proof-
from that(1) have [cat_op_simps]:
"f' : X ↦⇘ℭ⇙ X' ∧
x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘op_cat ℭ⇙ f' ∧
x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘op_cat ℭ⇙ f' ⟷
f' : X ↦⇘ℭ⇙ X' ∧
x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = f' ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∧
x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = f' ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈"
for f'
by (intro iffI conjI; (elim conjE)?)
(
cs_concl
cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
cs_intro: cat_cs_intros cat_ss_cs_intros
)+
interpret x':
is_cat_cone α X' ‹→∙←⇩C› ‹op_cat ℭ› ‹⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘op_cat ℭ⇙› x'
by (rule that)
show ?thesis
unfolding cat_op_simps
by
(
rule assms(3)[
OF x'.is_cat_cocone_op[unfolded cat_op_simps],
unfolded cat_op_simps
]
)
qed
interpret op_x: is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ‹op_cat ℭ› X ‹op_ntcf x›
using
is_cat_pullbackI'
[
OF x.is_cat_cone_op[unfolded cat_op_simps]
span.cf_scospan_op,
unfolded cat_op_simps,
OF assms_3'
]
by simp
show "x : 𝔞←𝔤←𝔬→𝔣→𝔟 >⇩C⇩F⇩.⇩p⇩o X ↦↦⇩C⇘α⇙ ℭ"
by (rule op_x.is_cat_pushout_op[unfolded cat_op_simps])
qed
lemma (in is_cat_pullback) cat_pb_unique_cone:
assumes "x' : X' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙ : →∙←⇩C ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'.
f' : X' ↦⇘ℭ⇙ X ∧
x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f' ∧
x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f'"
proof-
interpret x': is_cat_cone α X' ‹→∙←⇩C› ℭ ‹⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙› x'
by (rule assms)
from cat_lim_unique_cone[OF assms] obtain f'
where f': "f' : X' ↦⇘ℭ⇙ X"
and x'_def: "x' = x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f'"
and unique_f': "⋀f''.
⟦ f'' : X' ↦⇘ℭ⇙ X; x' = x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f'' ⟧ ⟹
f'' = f'"
by auto
have 𝔞⇩S⇩S: "𝔞⇩S⇩S ∈⇩∘ →∙←⇩C⦇Obj⦈" and 𝔟⇩S⇩S: "𝔟⇩S⇩S ∈⇩∘ →∙←⇩C⦇Obj⦈"
by (cs_concl cs_intro: cat_ss_cs_intros)+
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
show "f' : X' ↦⇘ℭ⇙ X" by (rule f')
have "x'⦇NTMap⦈⦇a⦈ = x⦇NTMap⦈⦇a⦈ ∘⇩A⇘ℭ⇙ f'" if "a ∈⇩∘ →∙←⇩C⦇Obj⦈" for a
proof-
from x'_def have
"x'⦇NTMap⦈⦇a⦈ = (x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f')⦇NTMap⦈⦇a⦈"
by simp
from this that f' show "x'⦇NTMap⦈⦇a⦈ = x⦇NTMap⦈⦇a⦈ ∘⇩A⇘ℭ⇙ f'"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
from this[OF 𝔞⇩S⇩S] this[OF 𝔟⇩S⇩S] show
"x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f'"
"x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f'"
by auto
fix f'' assume prems':
"f'' : X' ↦⇘ℭ⇙ X"
"x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f''"
"x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f''"
have "x' = x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f''"
proof(rule ntcf_eqI)
show "x' : cf_const →∙←⇩C ℭ X' ↦⇩C⇩F ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙ : →∙←⇩C ↦↦⇩C⇘α⇙ ℭ"
by (rule x'.is_ntcf_axioms)
from prems'(1) show
"x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f'' :
cf_const →∙←⇩C ℭ X' ↦⇩C⇩F ⟨𝔞→𝔤→𝔬←𝔣←𝔟⟩⇩C⇩F⇘ℭ⇙ :
→∙←⇩C ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have dom_lhs: "𝒟⇩∘ (x'⦇NTMap⦈) = →∙←⇩C⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
from prems'(1) have dom_rhs:
"𝒟⇩∘ ((x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f'')⦇NTMap⦈) = →∙←⇩C⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "x'⦇NTMap⦈ = (x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f'')⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems'': "a ∈⇩∘ →∙←⇩C⦇Obj⦈"
from this prems'(1) show
"x'⦇NTMap⦈⦇a⦈ = (x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f'')⦇NTMap⦈⦇a⦈"
by (elim the_cat_scospan_ObjE; simp only:)
(
cs_concl
cs_simp:
prems'(2,3)
cat_cone_cospan(1,2)[OF assms cf_scospan_axioms]
cat_pb_cone_cospan
cat_ss_cs_simps cat_cs_simps
cs_intro: cat_ss_cs_intros cat_cs_intros
)+
qed (auto simp: cat_cs_intros)
qed simp_all
from unique_f'[OF prems'(1) this] show "f'' = f'".
qed
qed
lemma (in is_cat_pullback) cat_pb_unique:
assumes "x' : X' <⇩C⇩F⇩.⇩p⇩b 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : X' ↦⇘ℭ⇙ X ∧ x' = x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f'"
by (rule cat_lim_unique[OF is_cat_pullbackD(1)[OF assms]])
lemma (in is_cat_pullback) cat_pb_unique':
assumes "x' : X' <⇩C⇩F⇩.⇩p⇩b 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'.
f' : X' ↦⇘ℭ⇙ X ∧
x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f' ∧
x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f'"
proof-
interpret x': is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X' x' by (rule assms(1))
show ?thesis by (rule cat_pb_unique_cone[OF x'.is_cat_cone_axioms])
qed
lemma (in is_cat_pushout) cat_po_unique_cocone:
assumes "x' : ⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩⇩C⇩F⇘ℭ⇙ >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e X' : ←∙→⇩C ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'.
f' : X ↦⇘ℭ⇙ X' ∧
x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = f' ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∧
x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = f' ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈"
proof-
interpret x': is_cat_cocone α X' ‹←∙→⇩C› ℭ ‹⟨𝔞←𝔤←𝔬→𝔣→𝔟⟩⇩C⇩F⇘ℭ⇙› x'
by (rule assms(1))
have [cat_op_simps]:
"f' : X ↦⇘ℭ⇙ X' ∧
x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘op_cat ℭ⇙ f' ∧
x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘op_cat ℭ⇙ f' ⟷
f' : X ↦⇘ℭ⇙ X' ∧
x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = f' ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∧
x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = f' ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈"
for f'
by (intro iffI conjI; (elim conjE)?)
(
cs_concl
cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
cs_intro: cat_cs_intros cat_ss_cs_intros
)+
show ?thesis
by
(
rule is_cat_pullback.cat_pb_unique_cone[
OF is_cat_pullback_op x'.is_cat_cone_op[unfolded cat_op_simps],
unfolded cat_op_simps
]
)
qed
lemma (in is_cat_pushout) cat_po_unique:
assumes "x' : 𝔞←𝔤←𝔬→𝔣→𝔟 >⇩C⇩F⇩.⇩p⇩o X' ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : X ↦⇘ℭ⇙ X' ∧ x' = ntcf_const ←∙→⇩C ℭ f' ∙⇩N⇩T⇩C⇩F x"
by (rule cat_colim_unique[OF is_cat_pushoutD(1)[OF assms]])
lemma (in is_cat_pushout) cat_po_unique':
assumes "x' : 𝔞←𝔤←𝔬→𝔣→𝔟 >⇩C⇩F⇩.⇩p⇩o X' ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'.
f' : X ↦⇘ℭ⇙ X' ∧
x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = f' ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∧
x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = f' ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈"
proof-
interpret x': is_cat_pushout α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X' x' by (rule assms(1))
show ?thesis by (rule cat_po_unique_cocone[OF x'.is_cat_cocone_axioms])
qed
lemma cat_pullback_ex_is_arr_isomorphism:
assumes "x : X <⇩C⇩F⇩.⇩p⇩b 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦⇩C⇘α⇙ ℭ"
and "x' : X' <⇩C⇩F⇩.⇩p⇩b 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : X' ↦⇩i⇩s⇩o⇘ℭ⇙ X"
and "x' = x ∙⇩N⇩T⇩C⇩F ntcf_const →∙←⇩C ℭ f"
proof-
interpret x: is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x by (rule assms(1))
interpret x': is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X' x' by (rule assms(2))
from that show ?thesis
by
(
elim cat_lim_ex_is_arr_isomorphism[
OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
]
)
qed
lemma cat_pullback_ex_is_arr_isomorphism':
assumes "x : X <⇩C⇩F⇩.⇩p⇩b 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦⇩C⇘α⇙ ℭ"
and "x' : X' <⇩C⇩F⇩.⇩p⇩b 𝔞→𝔤→𝔬←𝔣←𝔟 ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : X' ↦⇩i⇩s⇩o⇘ℭ⇙ X"
and "x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f"
and "x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f"
proof-
interpret x: is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x by (rule assms(1))
interpret x': is_cat_pullback α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X' x' by (rule assms(2))
obtain f where f: "f : X' ↦⇩i⇩s⇩o⇘ℭ⇙ X"
and "j ∈⇩∘ →∙←⇩C⦇Obj⦈ ⟹ x'⦇NTMap⦈⦇j⦈ = x⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f" for j
by
(
elim cat_lim_ex_is_arr_isomorphism'[
OF x.is_cat_limit_axioms x'.is_cat_limit_axioms
]
)
then have
"x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔞⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f"
"x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = x⦇NTMap⦈⦇𝔟⇩S⇩S⦈ ∘⇩A⇘ℭ⇙ f"
by (auto simp: cat_ss_cs_intros)
with f show ?thesis using that by simp
qed
lemma cat_pushout_ex_is_arr_isomorphism:
assumes "x : 𝔞←𝔤←𝔬→𝔣→𝔟 >⇩C⇩F⇩.⇩p⇩o X ↦↦⇩C⇘α⇙ ℭ"
and "x' : 𝔞←𝔤←𝔬→𝔣→𝔟 >⇩C⇩F⇩.⇩p⇩o X' ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : X ↦⇩i⇩s⇩o⇘ℭ⇙ X'"
and "x' = ntcf_const ←∙→⇩C ℭ f ∙⇩N⇩T⇩C⇩F x"
proof-
interpret x: is_cat_pushout α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x by (rule assms(1))
interpret x': is_cat_pushout α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X' x' by (rule assms(2))
from that show ?thesis
by
(
elim cat_colim_ex_is_arr_isomorphism[
OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms
]
)
qed
lemma cat_pushout_ex_is_arr_isomorphism':
assumes "x : 𝔞←𝔤←𝔬→𝔣→𝔟 >⇩C⇩F⇩.⇩p⇩o X ↦↦⇩C⇘α⇙ ℭ"
and "x' : 𝔞←𝔤←𝔬→𝔣→𝔟 >⇩C⇩F⇩.⇩p⇩o X' ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : X ↦⇩i⇩s⇩o⇘ℭ⇙ X'"
and "x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = f ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈"
and "x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = f ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈"
proof-
interpret x: is_cat_pushout α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X x by (rule assms(1))
interpret x': is_cat_pushout α 𝔞 𝔤 𝔬 𝔣 𝔟 ℭ X' x' by (rule assms(2))
obtain f where f: "f : X ↦⇩i⇩s⇩o⇘ℭ⇙ X'"
and "j ∈⇩∘ ←∙→⇩C⦇Obj⦈ ⟹ x'⦇NTMap⦈⦇j⦈ = f ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇j⦈" for j
by
(
elim cat_colim_ex_is_arr_isomorphism'[
OF x.is_cat_colimit_axioms x'.is_cat_colimit_axioms,
unfolded the_cat_parallel_components(1)
]
)
then have "x'⦇NTMap⦈⦇𝔞⇩S⇩S⦈ = f ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔞⇩S⇩S⦈"
and "x'⦇NTMap⦈⦇𝔟⇩S⇩S⦈ = f ∘⇩A⇘ℭ⇙ x⦇NTMap⦈⦇𝔟⇩S⇩S⦈"
by (auto simp: cat_ss_cs_intros)
with f show ?thesis using that by simp
qed
subsection‹Equalizers and coequalizers›
subsubsection‹Definition and elementary properties›
text‹
See \cite{noauthor_wikipedia_2001}\footnote{
\url{https://en.wikipedia.org/wiki/Equaliser_(mathematics)}
}.
›
locale is_cat_equalizer =
is_cat_limit α ‹↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L› ℭ ‹↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣› E ε
for α 𝔞 𝔟 𝔤 𝔣 ℭ E ε +
assumes cat_eq_𝔤[cat_lim_cs_intros]: "𝔤 : 𝔞 ↦⇘ℭ⇙ 𝔟"
and cat_eq_𝔣[cat_lim_cs_intros]: "𝔣 : 𝔞 ↦⇘ℭ⇙ 𝔟"
syntax "_is_cat_equalizer" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ <⇩C⇩F⇩.⇩e⇩q '(_,_,_,_') :/ ↑↑⇧2⇩C ↦↦⇩Cı _)› [51, 51, 51, 51, 51, 51] 51)
translations "ε : E <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε"
locale is_cat_coequalizer =
is_cat_colimit α ‹↑↑⇩C 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L› ℭ ‹↑↑→↑↑ ℭ 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤› E ε
for α 𝔞 𝔟 𝔤 𝔣 ℭ E ε +
assumes cat_coeq_𝔤[cat_lim_cs_intros]: "𝔤 : 𝔟 ↦⇘ℭ⇙ 𝔞"
and cat_coeq_𝔣[cat_lim_cs_intros]: "𝔣 : 𝔟 ↦⇘ℭ⇙ 𝔞"
syntax "_is_cat_coequalizer" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ '(_,_,_,_') >⇩C⇩F⇩.⇩c⇩o⇩e⇩q _ :/ ↑↑⇧2⇩C ↦↦⇩Cı _)› [51, 51, 51, 51, 51, 51] 51)
translations "ε : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ" ⇌
"CONST is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε"
text‹Rules.›
lemma (in is_cat_equalizer) is_cat_equalizer_axioms'[cat_lim_cs_intros]:
assumes "α' = α"
and "E' = E"
and "𝔞' = 𝔞"
and "𝔟' = 𝔟"
and "𝔤' = 𝔤"
and "𝔣' = 𝔣"
and "ℭ' = ℭ"
shows "ε : E' <⇩C⇩F⇩.⇩e⇩q (𝔞',𝔟',𝔤',𝔣') : ↑↑⇧2⇩C ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_equalizer_axioms)
mk_ide rf is_cat_equalizer_def[unfolded is_cat_equalizer_axioms_def]
|intro is_cat_equalizerI|
|dest is_cat_equalizerD[dest]|
|elim is_cat_equalizerE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_equalizerD(1)
lemma (in is_cat_coequalizer) is_cat_coequalizer_axioms'[cat_lim_cs_intros]:
assumes "α' = α"
and "E' = E"
and "𝔞' = 𝔞"
and "𝔟' = 𝔟"
and "𝔤' = 𝔤"
and "𝔣' = 𝔣"
and "ℭ' = ℭ"
shows "ε : (𝔞',𝔟',𝔤',𝔣') >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E' : ↑↑⇧2⇩C ↦↦⇩C⇘α'⇙ ℭ'"
unfolding assms by (rule is_cat_coequalizer_axioms)
mk_ide rf is_cat_coequalizer_def[unfolded is_cat_coequalizer_axioms_def]
|intro is_cat_coequalizerI|
|dest is_cat_coequalizerD[dest]|
|elim is_cat_coequalizerE[elim]|
lemmas [cat_lim_cs_intros] = is_cat_coequalizerD(1)
text‹Elementary properties.›
sublocale is_cat_equalizer ⊆ cf_parallel α 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 ℭ
by (intro cf_parallelI cat_parallelI)
(simp_all add: cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros)
sublocale is_cat_coequalizer ⊆ cf_parallel α 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤 ℭ
by (intro cf_parallelI cat_parallelI)
(
simp_all add:
cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
cat_PL_ineq[symmetric]
)
text‹Duality.›
lemma (in is_cat_equalizer) is_cat_coequalizer_op:
"op_ntcf ε : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ op_cat ℭ"
by (intro is_cat_coequalizerI)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros cat_lim_cs_intros)+
lemma (in is_cat_equalizer) is_cat_coequalizer_op'[cat_op_intros]:
assumes "ℭ' = op_cat ℭ"
shows "op_ntcf ε : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_coequalizer_op)
lemmas [cat_op_intros] = is_cat_equalizer.is_cat_coequalizer_op'
lemma (in is_cat_coequalizer) is_cat_equalizer_op:
"op_ntcf ε : E <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ op_cat ℭ"
by (intro is_cat_equalizerI)
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_lim_cs_intros
)+
lemma (in is_cat_coequalizer) is_cat_equalizer_op'[cat_op_intros]:
assumes "ℭ' = op_cat ℭ"
shows "op_ntcf ε : E <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cat_equalizer_op)
lemmas [cat_op_intros] = is_cat_coequalizer.is_cat_equalizer_op'
text‹Elementary properties.›
lemma cf_parallel_if_is_cat_cone:
assumes "ε :
E <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 : ↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L ↦↦⇩C⇘α⇙ ℭ"
and "𝔤 : 𝔞 ↦⇘ℭ⇙ 𝔟"
and "𝔣 : 𝔞 ↦⇘ℭ⇙ 𝔟"
shows "cf_parallel α 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 ℭ"
proof-
let ?II = ‹↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L› and ?II_II = ‹↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣›
interpret is_cat_cone α E ?II ℭ ?II_II ε by (rule assms(1))
show ?thesis
by (intro cf_parallelI cat_parallelI)
(
simp_all add:
assms cat_parallel_cs_intros cat_lim_cs_intros cat_cs_intros
)
qed
lemma cf_parallel_if_is_cat_cocone:
assumes "ε' :
↑↑→↑↑ ℭ 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤 >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e E' : ↑↑⇩C 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L ↦↦⇩C⇘α⇙ ℭ"
and "𝔤 : 𝔟 ↦⇘ℭ⇙ 𝔞"
and "𝔣 : 𝔟 ↦⇘ℭ⇙ 𝔞"
shows "cf_parallel α 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤 ℭ"
proof-
let ?II = ‹↑↑⇩C 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L› and ?II_II = ‹↑↑→↑↑ ℭ 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤›
interpret is_cat_cocone α E' ?II ℭ ?II_II ε' by (rule assms(1))
show ?thesis
by (intro cf_parallelI cat_parallelI)
(
simp_all add:
assms
cat_parallel_cs_intros
cat_lim_cs_intros
cat_cs_intros
cat_PL_ineq[symmetric]
)
qed
lemma (in category) cat_cf_parallel_cat_equalizer:
assumes "𝔤 : 𝔞 ↦⇘ℭ⇙ 𝔟" and "𝔣 : 𝔞 ↦⇘ℭ⇙ 𝔟"
shows "cf_parallel α 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 ℭ"
using assms
by (intro cf_parallelI cat_parallelI)
(auto simp: cat_parallel_cs_intros cat_cs_intros)
lemma (in category) cat_cf_parallel_cat_coequalizer:
assumes "𝔤 : 𝔟 ↦⇘ℭ⇙ 𝔞" and "𝔣 : 𝔟 ↦⇘ℭ⇙ 𝔞"
shows "cf_parallel α 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤 ℭ"
using assms
by (intro cf_parallelI cat_parallelI)
(simp_all add: cat_parallel_cs_intros cat_cs_intros cat_PL_ineq[symmetric])
lemma cat_cone_cf_par_eps_NTMap_app:
assumes "ε :
E <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 : ↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L ↦↦⇩C⇘α⇙ ℭ"
and "𝔤 : 𝔞 ↦⇘ℭ⇙ 𝔟"
and "𝔣 : 𝔞 ↦⇘ℭ⇙ 𝔟"
shows
"ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = 𝔤 ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
"ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = 𝔣 ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
proof-
let ?II = ‹↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L› and ?II_II = ‹↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣›
interpret ε: is_cat_cone α E ?II ℭ ?II_II ε by (rule assms(1))
from assms(2,3) have 𝔞: "𝔞 ∈⇩∘ ℭ⦇Obj⦈" and 𝔟: "𝔟 ∈⇩∘ ℭ⦇Obj⦈" by auto
interpret par: cf_parallel α 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 ℭ
by (intro cf_parallel_if_is_cat_cone, rule assms) (auto intro: assms 𝔞 𝔟)
have 𝔤⇩P⇩L: "𝔤⇩P⇩L : 𝔞⇩P⇩L ↦⇘↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L⇙ 𝔟⇩P⇩L"
and 𝔣⇩P⇩L: "𝔣⇩P⇩L : 𝔞⇩P⇩L ↦⇘↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L⇙ 𝔟⇩P⇩L"
by
(
simp_all add:
par.the_cat_parallel_is_arr_𝔞𝔟𝔤 par.the_cat_parallel_is_arr_𝔞𝔟𝔣
)
from ε.ntcf_Comp_commute[OF 𝔤⇩P⇩L] show "ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = 𝔤 ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
by
(
cs_prems
cs_simp: cat_parallel_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
from ε.ntcf_Comp_commute[OF 𝔣⇩P⇩L] show "ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = 𝔣 ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
by
(
cs_prems
cs_simp: cat_parallel_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
qed
lemma cat_cocone_cf_par_eps_NTMap_app:
assumes "ε :
↑↑→↑↑ ℭ 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤 >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e E : ↑↑⇩C 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L ↦↦⇩C⇘α⇙ ℭ"
and "𝔤 : 𝔟 ↦⇘ℭ⇙ 𝔞"
and "𝔣 : 𝔟 ↦⇘ℭ⇙ 𝔞"
shows
"ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ 𝔤"
"ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ 𝔣"
proof-
let ?II = ‹↑↑⇩C 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L› and ?II_II = ‹↑↑→↑↑ ℭ 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤›
interpret ε: is_cat_cocone α E ?II ℭ ?II_II ε by (rule assms(1))
from assms(2,3) have 𝔞: "𝔞 ∈⇩∘ ℭ⦇Obj⦈" and 𝔟: "𝔟 ∈⇩∘ ℭ⦇Obj⦈" by auto
interpret par: cf_parallel α 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤 ℭ
by (intro cf_parallel_if_is_cat_cocone, rule assms) (auto intro: assms 𝔞 𝔟)
note ε_NTMap_app =
cat_cone_cf_par_eps_NTMap_app[
OF ε.is_cat_cone_op[unfolded cat_op_simps],
unfolded cat_op_simps,
OF assms(2,3)
]
from ε_NTMap_app show ε_NTMap_app:
"ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ 𝔤"
"ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ 𝔣"
by
(
cs_concl
cs_simp: cat_parallel_cs_simps category.op_cat_Comp[symmetric]
cs_intro: cat_cs_intros cat_parallel_cs_intros
)+
qed
lemma (in is_cat_equalizer) cat_eq_2_eps_NTMap_app:
"ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = 𝔤 ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
"ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = 𝔣 ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
by
(
intro cat_cone_cf_par_eps_NTMap_app[
OF is_cat_cone_axioms cat_eq_𝔤 cat_eq_𝔣
]
)+
lemma (in is_cat_coequalizer) cat_coeq_2_eps_NTMap_app:
"ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ 𝔤"
"ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ 𝔣"
by
(
intro cat_cocone_cf_par_eps_NTMap_app[
OF is_cat_cocone_axioms cat_coeq_𝔤 cat_coeq_𝔣
]
)+
lemma (in is_cat_equalizer) cat_eq_Comp_eq:
"𝔤 ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = 𝔣 ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
"𝔣 ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = 𝔤 ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
unfolding cat_eq_2_eps_NTMap_app[symmetric] by simp_all
lemma (in is_cat_coequalizer) cat_coeq_Comp_eq:
"ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ 𝔤 = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ 𝔣"
"ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ 𝔣 = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ 𝔤"
unfolding cat_coeq_2_eps_NTMap_app[symmetric] by simp_all
subsubsection‹Universal property›
lemma is_cat_equalizerI':
assumes "ε :
E <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 : ↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L ↦↦⇩C⇘α⇙ ℭ"
and "𝔤 : 𝔞 ↦⇘ℭ⇙ 𝔟"
and "𝔣 : 𝔞 ↦⇘ℭ⇙ 𝔟"
and "⋀ε' E'. ε' :
E' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 :
↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L ↦↦⇩C⇘α⇙ ℭ ⟹
∃!f'. f' : E' ↦⇘ℭ⇙ E ∧ ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ f'"
shows "ε : E <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
proof-
let ?II = ‹↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L› and ?II_II = ‹↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣›
interpret ε: is_cat_cone α E ?II ℭ ?II_II ε by (rule assms(1))
interpret ℭ: cf_parallel α 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 ℭ
by (rule ε.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms(2,3)])
show ?thesis
proof(intro is_cat_equalizerI is_cat_limitI' assms(1-3))
fix u' r' assume prems: "u' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ?II_II : ?II ↦↦⇩C⇘α⇙ ℭ"
interpret u': is_cat_cone α r' ?II ℭ ?II_II u' by (rule prems)
from assms(4)[OF prems] obtain f'
where f': "f' : r' ↦⇘ℭ⇙ E"
and u'_NTMap_app_𝔞: "u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ f'"
and unique_f':
"⋀f''.
⟦
f'' : r' ↦⇘ℭ⇙ E;
u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ f''
⟧ ⟹ f'' = f'"
by metis
show "∃!f'. f' : r' ↦⇘ℭ⇙ E ∧ u' = ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f'"
proof(intro ex1I conjI; (elim conjE)?)
show "u' = ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f'"
proof(rule ntcf_eqI)
show "u' : cf_const ?II ℭ r' ↦⇩C⇩F ?II_II : ?II ↦↦⇩C⇘α⇙ ℭ"
by (rule u'.is_ntcf_axioms)
from f' show "ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f' :
cf_const ?II ℭ r' ↦⇩C⇩F ?II_II : ?II ↦↦⇩C⇘α⇙ ℭ"
by
(
cs_concl
cs_simp: cat_cs_simps cat_ss_cs_simps
cs_intro: cat_cs_intros cat_ss_cs_intros
)
have dom_lhs: "𝒟⇩∘ (u'⦇NTMap⦈) = ?II⦇Obj⦈"
unfolding cat_cs_simps by simp
from f' have dom_rhs:
"𝒟⇩∘ ((ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f')⦇NTMap⦈) = ?II⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "u'⦇NTMap⦈ = (ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f')⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems': "a ∈⇩∘ ?II⦇Obj⦈"
note [cat_parallel_cs_simps] =
cat_cone_cf_par_eps_NTMap_app[OF u'.is_cat_cone_axioms assms(2-3)]
cat_cone_cf_par_eps_NTMap_app[OF assms(1-3)]
u'_NTMap_app_𝔞
from prems' f' assms(2,3) show
"u'⦇NTMap⦈⦇a⦈ = (ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f')⦇NTMap⦈⦇a⦈"
by (elim the_cat_parallel_ObjE; simp only:)
(
cs_concl
cs_simp: cat_parallel_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
qed (cs_concl cs_intro: V_cs_intros cat_cs_intros)+
qed simp_all
fix f'' assume prems'':
"f'' : r' ↦⇘ℭ⇙ E" "u' = ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f''"
from prems''(2) have u'_NTMap_a:
"u'⦇NTMap⦈⦇a⦈ = (ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f'')⦇NTMap⦈⦇a⦈"
for a
by simp
have "u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ f''"
using u'_NTMap_a[of 𝔞⇩P⇩L] prems''(1)
by
(
cs_prems
cs_simp: cat_parallel_cs_simps cat_cs_simps
cs_intro: cat_parallel_cs_intros cat_cs_intros
)
from unique_f'[OF prems''(1) this] show "f'' = f'".
qed (rule f')
qed
qed
lemma is_cat_coequalizerI':
assumes "ε :
↑↑→↑↑ ℭ 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤 >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e E :
↑↑⇩C 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L ↦↦⇩C⇘α⇙ ℭ"
and "𝔤 : 𝔟 ↦⇘ℭ⇙ 𝔞"
and "𝔣 : 𝔟 ↦⇘ℭ⇙ 𝔞"
and "⋀ε' E'. ε' :
↑↑→↑↑ ℭ 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤 >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e E' :
↑↑⇩C 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L ↦↦⇩C⇘α⇙ ℭ ⟹
∃!f'. f' : E ↦⇘ℭ⇙ E' ∧ ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = f' ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
shows "ε : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
proof-
let ?op_II = ‹↑↑⇩C 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L›
and ?op_II_II = ‹↑↑→↑↑ ℭ 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤›
and ?II = ‹↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L›
and ?II_II = ‹↑↑→↑↑ (op_cat ℭ) 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣›
interpret ε: is_cat_cocone α E ?op_II ℭ ?op_II_II ε by (rule assms(1))
interpret par: cf_parallel α 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤 ℭ
by (rule ε.NTDom.HomCod.cat_cf_parallel_cat_coequalizer[OF assms(2,3)])
interpret op_par: cf_parallel α 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 ‹op_cat ℭ›
by (rule par.cf_parallel_op)
have assms_4':
"∃!f'. f' : E ↦⇘ℭ⇙ E' ∧ ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘op_cat ℭ⇙ f'"
if "ε' : E' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ?II_II : ?II ↦↦⇩C⇘α⇙ op_cat ℭ" for ε' E'
proof-
have [cat_op_simps]:
"f' : E ↦⇘ℭ⇙ E' ∧ ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘op_cat ℭ⇙ f' ⟷
f' : E ↦⇘ℭ⇙ E' ∧ ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = f' ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
for f'
by (intro iffI conjI; (elim conjE)?)
(
cs_concl
cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)+
interpret ε': is_cat_cone α E' ?II ‹op_cat ℭ› ?II_II ε' by (rule that)
show ?thesis
unfolding cat_op_simps
by
(
rule assms(4)[
OF ε'.is_cat_cocone_op[unfolded cat_op_simps],
unfolded cat_op_simps
]
)
qed
interpret op_ε: is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ‹op_cat ℭ› E ‹op_ntcf ε›
by
(
rule
is_cat_equalizerI'
[
OF ε.is_cat_cone_op[unfolded cat_op_simps],
unfolded cat_op_simps,
OF assms(2,3) assms_4'
]
)
show ?thesis by (rule op_ε.is_cat_coequalizer_op[unfolded cat_op_simps])
qed
lemma (in is_cat_equalizer) cat_eq_unique_cone:
assumes "ε' :
E' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 : ↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L ↦↦⇩C⇘α⇙ ℭ"
(is ‹ε' : E' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ?II_II : ?II ↦↦⇩C⇘α⇙ ℭ›)
shows "∃!f'. f' : E' ↦⇘ℭ⇙ E ∧ ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ f'"
proof-
interpret ε': is_cat_cone α E' ?II ℭ ?II_II ε' by (rule assms(1))
from cat_lim_unique_cone[OF assms(1)] obtain f' where f': "f' : E' ↦⇘ℭ⇙ E"
and ε'_def: "ε' = ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f'"
and unique:
"⟦ f'' : E' ↦⇘ℭ⇙ E; ε' = ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f'' ⟧ ⟹ f'' = f'"
for f''
by auto
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
show f': "f' : E' ↦⇘ℭ⇙ E" by (rule f')
from ε'_def have "ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = (ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f')⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
by simp
from this f' show ε'_NTMap_app_I: "ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ f'"
by
(
cs_prems
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_parallel_cs_intros
)
fix f'' assume prems:
"f'' : E' ↦⇘ℭ⇙ E" "ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ f''"
have "ε' = ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f''"
proof(rule ntcf_eqI[OF ])
show "ε' : cf_const ?II ℭ E' ↦⇩C⇩F ?II_II : ?II ↦↦⇩C⇘α⇙ ℭ"
by (rule ε'.is_ntcf_axioms)
from f' prems(1) show "ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f'' :
cf_const ?II ℭ E' ↦⇩C⇩F ?II_II : ?II ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "ε'⦇NTMap⦈ = (ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f'')⦇NTMap⦈"
proof(rule vsv_eqI, unfold cat_cs_simps)
show "vsv ((ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f'')⦇NTMap⦈)"
by (cs_concl cs_intro: cat_cs_intros)
from prems(1) show
"?II⦇Obj⦈ = 𝒟⇩∘ ((ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f'')⦇NTMap⦈)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
fix a assume prems': "a ∈⇩∘ ?II⦇Obj⦈"
note [cat_cs_simps] =
cat_eq_2_eps_NTMap_app
cat_cone_cf_par_eps_NTMap_app[
OF ε'.is_cat_cone_axioms cf_parallel_𝔤' cf_parallel_𝔣'
]
from prems' prems(1) have [cat_cs_simps]:
"ε'⦇NTMap⦈⦇a⦈ = ε⦇NTMap⦈⦇a⦈ ∘⇩A⇘ℭ⇙ f''"
by (elim the_cat_parallel_ObjE; simp only:)
(
cs_concl
cs_simp: cat_cs_simps cat_parallel_cs_simps prems(2)
cs_intro: cat_cs_intros cat_parallel_cs_intros
)+
from prems' prems show
"ε'⦇NTMap⦈⦇a⦈ = (ε ∙⇩N⇩T⇩C⇩F ntcf_const ?II ℭ f'')⦇NTMap⦈⦇a⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed auto
qed simp_all
from unique[OF prems(1) this] show "f'' = f'" .
qed
qed
lemma (in is_cat_equalizer) cat_eq_unique:
assumes "ε' : E' <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
shows
"∃!f'. f' : E' ↦⇘ℭ⇙ E ∧ ε' = ε ∙⇩N⇩T⇩C⇩F ntcf_const (↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L) ℭ f'"
by (rule cat_lim_unique[OF is_cat_equalizerD(1)[OF assms]])
lemma (in is_cat_equalizer) cat_eq_unique':
assumes "ε' : E' <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : E' ↦⇘ℭ⇙ E ∧ ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ f'"
proof-
interpret ε': is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E' ε' by (rule assms(1))
show ?thesis by (rule cat_eq_unique_cone[OF ε'.is_cat_cone_axioms])
qed
lemma (in is_cat_coequalizer) cat_coeq_unique_cocone:
assumes "ε' :
↑↑→↑↑ ℭ 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L 𝔟 𝔞 𝔣 𝔤 >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e E' : ↑↑⇩C 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L ↦↦⇩C⇘α⇙ ℭ"
(is ‹ε' : ?II_II >⇩C⇩F⇩.⇩c⇩o⇩c⇩o⇩n⇩e E' : ?II ↦↦⇩C⇘α⇙ ℭ›)
shows "∃!f'. f' : E ↦⇘ℭ⇙ E' ∧ ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = f' ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
proof-
interpret ε': is_cat_cocone α E' ?II ℭ ?II_II ε' by (rule assms(1))
have [cat_op_simps]:
"f' : E ↦⇘ℭ⇙ E' ∧ ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘op_cat ℭ⇙ f' ⟷
f' : E ↦⇘ℭ⇙ E' ∧ ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = f' ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
for f'
by (intro iffI conjI; (elim conjE)?)
(
cs_concl
cs_simp: category.op_cat_Comp[symmetric] cat_op_simps cat_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)+
show ?thesis
by
(
rule is_cat_equalizer.cat_eq_unique_cone[
OF is_cat_equalizer_op ε'.is_cat_cone_op[unfolded cat_op_simps],
unfolded cat_op_simps
]
)
qed
lemma (in is_cat_coequalizer) cat_coeq_unique:
assumes "ε' : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E' : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'.
f' : E ↦⇘ℭ⇙ E' ∧
ε' = ntcf_const (↑↑⇩C 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L) ℭ f' ∙⇩N⇩T⇩C⇩F ε"
by (rule cat_colim_unique[OF is_cat_coequalizerD(1)[OF assms]])
lemma (in is_cat_coequalizer) cat_coeq_unique':
assumes "ε' : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E' : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
shows "∃!f'. f' : E ↦⇘ℭ⇙ E' ∧ ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = f' ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
proof-
interpret ε': is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E' ε' by (rule assms(1))
show ?thesis by (rule cat_coeq_unique_cocone[OF ε'.is_cat_cocone_axioms])
qed
lemma cat_equalizer_2_ex_is_arr_isomorphism:
assumes "ε : E <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
and "ε' : E' <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : E' ↦⇩i⇩s⇩o⇘ℭ⇙ E"
and "ε' = ε ∙⇩N⇩T⇩C⇩F ntcf_const (↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L) ℭ f"
proof-
interpret ε: is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε by (rule assms(1))
interpret ε': is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E' ε' by (rule assms(2))
from that show ?thesis
by
(
elim cat_lim_ex_is_arr_isomorphism[
OF ε.is_cat_limit_axioms ε'.is_cat_limit_axioms
]
)
qed
lemma cat_equalizer_2_ex_is_arr_isomorphism':
assumes "ε : E <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
and "ε' : E' <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : E' ↦⇩i⇩s⇩o⇘ℭ⇙ E"
and "ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ f"
and "ε'⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ f"
proof-
interpret ε: is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε by (rule assms(1))
interpret ε': is_cat_equalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E' ε' by (rule assms(2))
obtain f where f: "f : E' ↦⇩i⇩s⇩o⇘ℭ⇙ E"
and "j ∈⇩∘ ↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L⦇Obj⦈ ⟹ ε'⦇NTMap⦈⦇j⦈ = ε⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f" for j
by
(
elim cat_lim_ex_is_arr_isomorphism'[
OF ε.is_cat_limit_axioms ε'.is_cat_limit_axioms
]
)
then have
"ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ f"
"ε'⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ f"
unfolding the_cat_parallel_components by auto
with f show ?thesis using that by simp
qed
lemma cat_coequalizer_2_ex_is_arr_isomorphism:
assumes "ε : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
and "ε' : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E' : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : E ↦⇩i⇩s⇩o⇘ℭ⇙ E'"
and "ε' = ntcf_const (↑↑⇩C 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L) ℭ f ∙⇩N⇩T⇩C⇩F ε"
proof-
interpret ε: is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε by (rule assms(1))
interpret ε': is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E' ε' by (rule assms(2))
from that show ?thesis
by
(
elim cat_colim_ex_is_arr_isomorphism[
OF ε.is_cat_colimit_axioms ε'.is_cat_colimit_axioms
]
)
qed
lemma cat_coequalizer_2_ex_is_arr_isomorphism':
assumes "ε : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
and "ε' : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E' : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
obtains f where "f : E ↦⇩i⇩s⇩o⇘ℭ⇙ E'"
and "ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = f ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
and "ε'⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = f ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈"
proof-
interpret ε: is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε by (rule assms(1))
interpret ε': is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E' ε' by (rule assms(2))
obtain f where f: "f : E ↦⇩i⇩s⇩o⇘ℭ⇙ E'"
and "j ∈⇩∘ ↑↑⇩C 𝔟⇩P⇩L 𝔞⇩P⇩L 𝔣⇩P⇩L 𝔤⇩P⇩L⦇Obj⦈ ⟹ ε'⦇NTMap⦈⦇j⦈ = f ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇j⦈" for j
by
(
elim cat_colim_ex_is_arr_isomorphism'[
OF ε.is_cat_colimit_axioms ε'.is_cat_colimit_axioms
]
)
then have
"ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = f ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
"ε'⦇NTMap⦈⦇𝔟⇩P⇩L⦈ = f ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔟⇩P⇩L⦈"
unfolding the_cat_parallel_components by auto
with f show ?thesis using that by simp
qed
subsection‹Projection cone›
subsubsection‹Definition and elementary properties›
definition ntcf_obj_prod_base :: "V ⇒ V ⇒ (V ⇒ V) ⇒ V ⇒ (V ⇒ V) ⇒ V"
where "ntcf_obj_prod_base ℭ I F P f =
[(λj∈⇩∘:⇩C I⦇Obj⦈. f j), cf_const (:⇩C I) ℭ P, :→: I F ℭ, :⇩C I, ℭ]⇩∘"
text‹Components.›
lemma ntcf_obj_prod_base_components:
shows "ntcf_obj_prod_base ℭ I F P f⦇NTMap⦈ = (λj∈⇩∘:⇩C I⦇Obj⦈. f j)"
and "ntcf_obj_prod_base ℭ I F P f⦇NTDom⦈ = cf_const (:⇩C I) ℭ P"
and "ntcf_obj_prod_base ℭ I F P f⦇NTCod⦈ = :→: I F ℭ"
and "ntcf_obj_prod_base ℭ I F P f⦇NTDGDom⦈ = :⇩C I"
and "ntcf_obj_prod_base ℭ I F P f⦇NTDGCod⦈ = ℭ"
unfolding ntcf_obj_prod_base_def nt_field_simps
by (simp_all add: nat_omega_simps)
subsubsection‹Natural transformation map›
mk_VLambda ntcf_obj_prod_base_components(1)
|vsv ntcf_obj_prod_base_NTMap_vsv[cat_cs_intros]|
|vdomain ntcf_obj_prod_base_NTMap_vdomain[cat_cs_simps]|
|app ntcf_obj_prod_base_NTMap_app[cat_cs_simps]|
subsubsection‹Projection natural transformation is a cone›
lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone:
assumes "P ∈⇩∘ ℭ⦇Obj⦈" and "⋀a. a ∈⇩∘ I ⟹ f a : P ↦⇘ℭ⇙ F a"
shows "ntcf_obj_prod_base ℭ I F P f : P <⇩C⇩F⇩.⇩c⇩o⇩n⇩e :→: I F ℭ : :⇩C I ↦↦⇩C⇘α⇙ ℭ"
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
from assms(2) have [cat_cs_intros]:
"⟦ a ∈⇩∘ I; P' = P; Fa = F a ⟧ ⟹ f a : P' ↦⇘ℭ⇙ Fa" for a P' Fa
by simp
show "vfsequence (ntcf_obj_prod_base ℭ I F P f)"
unfolding ntcf_obj_prod_base_def by auto
show "vcard (ntcf_obj_prod_base ℭ I F P f) = 5⇩ℕ"
unfolding ntcf_obj_prod_base_def by (auto simp: nat_omega_simps)
from assms show "cf_const (:⇩C I) ℭ P : :⇩C I ↦↦⇩C⇘α⇙ ℭ"
by
(
cs_concl
cs_intro:
cf_discrete_vdomain_vsubset_Vset
cat_discrete_cs_intros
cat_cs_intros
)
show ":→: I F ℭ : :⇩C I ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_intro: cat_discrete_cs_intros)
show "ntcf_obj_prod_base ℭ I F P f⦇NTMap⦈⦇a⦈ :
cf_const (:⇩C I) ℭ P⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ :→: I F ℭ⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ :⇩C I⦇Obj⦈" for a
proof-
from that have "a ∈⇩∘ I" unfolding the_cat_discrete_components by simp
from that this show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_discrete_cs_simps cs_intro: cat_cs_intros
)
qed
show
"ntcf_obj_prod_base ℭ I F P f⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙
cf_const (:⇩C I) ℭ P⦇ArrMap⦈⦇g⦈ =
:→: I F ℭ⦇ArrMap⦈⦇g⦈ ∘⇩A⇘ℭ⇙ ntcf_obj_prod_base ℭ I F P f⦇NTMap⦈⦇a⦈"
if "g : a ↦⇘:⇩C I⇙ b" for a b g
proof-
note g = the_cat_discrete_is_arrD[OF that]
from that g(4)[unfolded g(7-9)] g(1)[unfolded g(7-9)] show ?thesis
unfolding g(7-9)
by
(
cs_concl
cs_simp: cat_cs_simps cat_discrete_cs_simps
cs_intro:
cf_discrete_vdomain_vsubset_Vset
cat_cs_intros cat_discrete_cs_intros
)
qed
from assms(1) show "cf_const (:⇩C I) ℭ P : :⇩C I ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
by
(
cs_concl cs_intro:
cat_cs_intros cat_small_cs_intros cat_small_discrete_cs_intros
)
qed
(
auto simp:
assms
ntcf_obj_prod_base_components
tm_cf_discrete_the_cf_discrete_is_tm_functor
)
lemma (in tm_cf_discrete) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
assumes "P ∈⇩∘ ℭ⦇Obj⦈"
and "⋀a. a ∈⇩∘ I ⟹ f a : P ↦⇘ℭ⇙ F a"
and "⋀u' r'.
⟦ u' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e :→: I F ℭ : :⇩C I ↦↦⇩C⇘α⇙ ℭ ⟧ ⟹
∃!f'.
f' : r' ↦⇘ℭ⇙ P ∧
u' = ntcf_obj_prod_base ℭ I F P f ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C I) ℭ f'"
shows "ntcf_obj_prod_base ℭ I F P f : P <⇩C⇩F⇩.⇩∏ F : I ↦↦⇩C⇘α⇙ ℭ"
proof
(
intro
is_cat_obj_prodI
is_cat_limitI'
tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone[OF assms(1,2), simplified]
assms(1,3)
)
show "cf_discrete α I F ℭ"
by (cs_concl cs_intro: cat_small_discrete_cs_intros)
qed
subsection‹Equalizer cone›
subsubsection‹Definition and elementary properties›
definition ntcf_equalizer_base :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ (V ⇒ V) ⇒ V"
where "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e =
[
(λx∈⇩∘↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L⦇Obj⦈. e x),
cf_const (↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L) ℭ E,
↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣,
↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L,
ℭ
]⇩∘"
text‹Components.›
lemma ntcf_equalizer_base_components:
shows "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTMap⦈ =
(λx∈⇩∘↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L⦇Obj⦈. e x)"
and [cat_lim_cs_simps]: "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTDom⦈ =
cf_const (↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L) ℭ E"
and [cat_lim_cs_simps]: "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTCod⦈ =
↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣"
and [cat_lim_cs_simps]:
"ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTDGDom⦈ = ↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L"
and [cat_lim_cs_simps]:
"ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTDGCod⦈ = ℭ"
unfolding ntcf_equalizer_base_def nt_field_simps
by (simp_all add: nat_omega_simps)
subsubsection‹Natural transformation map›
mk_VLambda ntcf_equalizer_base_components(1)
|vsv ntcf_equalizer_base_NTMap_vsv[cat_lim_cs_intros]|
|vdomain ntcf_equalizer_base_NTMap_vdomain[cat_lim_cs_simps]|
|app ntcf_equalizer_base_NTMap_app[cat_lim_cs_simps]|
subsubsection‹Equalizer cone is a cone›
lemma (in category) cat_ntcf_equalizer_base_is_cat_cone:
assumes "e 𝔞⇩P⇩L : E ↦⇘ℭ⇙ 𝔞"
and "e 𝔟⇩P⇩L : E ↦⇘ℭ⇙ 𝔟"
and "e 𝔟⇩P⇩L = 𝔤 ∘⇩A⇘ℭ⇙ e 𝔞⇩P⇩L"
and "e 𝔟⇩P⇩L = 𝔣 ∘⇩A⇘ℭ⇙ e 𝔞⇩P⇩L"
and "𝔤 : 𝔞 ↦⇘ℭ⇙ 𝔟"
and "𝔣 : 𝔞 ↦⇘ℭ⇙ 𝔟"
shows "ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e :
E <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 :
↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L ↦↦⇩C⇘α⇙ ℭ"
proof-
interpret par: cf_parallel α 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 ℭ
by (intro cf_parallelI cat_parallelI assms(5,6))
(simp_all add: cat_parallel_cs_intros cat_cs_intros)
show ?thesis
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
show "vfsequence (ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e)"
unfolding ntcf_equalizer_base_def by auto
show "vcard (ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e) = 5⇩ℕ"
unfolding ntcf_equalizer_base_def by (simp add: nat_omega_simps)
from assms(2) show
"cf_const (↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L) ℭ E : ↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros cat_parallel_cs_intros cat_cs_intros
)
then show "cf_const (↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L) ℭ E : ↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_intro: cat_small_cs_intros)
from assms show
"↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 : ↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_parallel_cs_intros)
then show "↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣 : ↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_intro: cat_small_cs_intros)
show
"ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTMap⦈⦇i⦈ :
cf_const (↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L) ℭ E⦇ObjMap⦈⦇i⦈ ↦⇘ℭ⇙
↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣⦇ObjMap⦈⦇i⦈"
if "i ∈⇩∘ ↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L⦇Obj⦈" for i
proof-
from that assms(1,2,5,6) show ?thesis
by (elim the_cat_parallel_ObjE; simp only:)
(
cs_concl
cs_simp: cat_lim_cs_simps cat_cs_simps cat_parallel_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
qed
show
"ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTMap⦈⦇b'⦈ ∘⇩A⇘ℭ⇙
cf_const (↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L) ℭ E⦇ArrMap⦈⦇f'⦈ =
↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘ℭ⇙
ntcf_equalizer_base ℭ 𝔞 𝔟 𝔤 𝔣 E e⦇NTMap⦈⦇a'⦈"
if "f' : a' ↦⇘↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L⇙ b'" for a' b' f'
using that assms(1,2,5,6)
by (elim par.the_cat_parallel_is_arrE; simp only:)
(
cs_concl
cs_simp:
cat_cs_simps
cat_lim_cs_simps
cat_parallel_cs_simps
assms(3,4)[symmetric]
cs_intro: cat_parallel_cs_intros
)+
qed
(
use assms(2) in
‹
cs_concl
cs_intro: cat_lim_cs_intros cat_cs_intros
cs_simp: cat_lim_cs_simps
›
)+
qed
subsection‹Limits by products and equalizers›
lemma cat_limit_of_cat_prod_obj_and_cat_equalizer:
assumes "𝔉 : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "⋀𝔞 𝔟 𝔤 𝔣. ⟦ 𝔣 : 𝔞 ↦⇘ℭ⇙ 𝔟; 𝔤 : 𝔞 ↦⇘ℭ⇙ 𝔟 ⟧ ⟹
∃E ε. ε : E <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
and "⋀A. tm_cf_discrete α (𝔍⦇Obj⦈) A ℭ ⟹
∃P π. π : P <⇩C⇩F⇩.⇩∏ A : 𝔍⦇Obj⦈ ↦↦⇩C⇘α⇙ ℭ"
and "⋀A. tm_cf_discrete α (𝔍⦇Arr⦈) A ℭ ⟹
∃P π. π : P <⇩C⇩F⇩.⇩∏ A : 𝔍⦇Arr⦈ ↦↦⇩C⇘α⇙ ℭ"
obtains r u where "u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
proof-
let ?L =‹λu. 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇u⦈⦈› and ?R =‹λi. 𝔉⦇ObjMap⦈⦇i⦈›
interpret 𝔉: is_tm_functor α 𝔍 ℭ 𝔉 by (rule assms(1))
have "?R j ∈⇩∘ ℭ⦇Obj⦈" if "j ∈⇩∘ 𝔍⦇Obj⦈" for j
by (cs_concl cs_intro: cat_cs_intros that)
have "tm_cf_discrete α (𝔍⦇Obj⦈) ?R ℭ"
proof(intro tm_cf_discreteI)
show "𝔉⦇ObjMap⦈⦇i⦈ ∈⇩∘ ℭ⦇Obj⦈" if "i ∈⇩∘ 𝔍⦇Obj⦈" for i
by (cs_concl cs_intro: cat_cs_intros that)
show "VLambda (𝔍⦇Obj⦈) ?R ∈⇩∘ Vset α"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
show "ℛ⇩∘ (VLambda (𝔍⦇Obj⦈) ?R) ∈⇩∘ Vset α"
proof-
have "ℛ⇩∘ (VLambda (𝔍⦇Obj⦈) ?R) ⊆⇩∘ ℛ⇩∘ (𝔉⦇ObjMap⦈)"
by (auto simp: 𝔉.cf_ObjMap_vdomain)
moreover have "ℛ⇩∘ (𝔉⦇ObjMap⦈) ∈⇩∘ Vset α"
by (force intro: vrange_in_VsetI 𝔉.tm_cf_ObjMap_in_Vset)
ultimately show ?thesis by auto
qed
qed (auto simp: cat_small_cs_intros)
show "(λi∈⇩∘𝔍⦇Obj⦈. ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇i⦈⦈) ∈⇩∘ Vset α"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
show "ℛ⇩∘ (λi∈⇩∘𝔍⦇Obj⦈. ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇i⦈⦈) ∈⇩∘ Vset α"
proof-
have "ℛ⇩∘ (λi∈⇩∘𝔍⦇Obj⦈. ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇i⦈⦈) ⊆⇩∘ ℛ⇩∘ (𝔉⦇ArrMap⦈)"
proof(rule vrange_VLambda_vsubset)
fix x assume x: "x ∈⇩∘ 𝔍⦇Obj⦈"
then have "𝔍⦇CId⦈⦇x⦈ ∈⇩∘ 𝒟⇩∘ (𝔉⦇ArrMap⦈)"
by (auto intro: cat_cs_intros simp: cat_cs_simps)
moreover from x have "ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈ = 𝔉⦇ArrMap⦈⦇𝔍⦇CId⦈⦇x⦈⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
ultimately show "ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈ ∈⇩∘ ℛ⇩∘ (𝔉⦇ArrMap⦈)"
by (simp add: 𝔉.ArrMap.vsv_vimageI2)
qed
moreover have "ℛ⇩∘ (𝔉⦇ArrMap⦈) ∈⇩∘ Vset α"
by (force intro: vrange_in_VsetI 𝔉.tm_cf_ArrMap_in_Vset)
ultimately show ?thesis by auto
qed
qed (auto simp: cat_small_cs_intros)
qed (auto intro: cat_cs_intros)
from assms(3)[where A=‹?R›, OF this] obtain P⇩O π⇩O
where π⇩O: "π⇩O : P⇩O <⇩C⇩F⇩.⇩∏ ?R : 𝔍⦇Obj⦈ ↦↦⇩C⇘α⇙ ℭ"
by clarsimp
interpret π⇩O: is_cat_obj_prod α ‹𝔍⦇Obj⦈› ?R ℭ P⇩O π⇩O by (rule π⇩O)
have P⇩O: "P⇩O ∈⇩∘ ℭ⦇Obj⦈" by (intro π⇩O.cat_cone_obj)
have "?L u ∈⇩∘ ℭ⦇Obj⦈" if "u ∈⇩∘ 𝔍⦇Arr⦈" for u
proof-
from that obtain a b where "u : a ↦⇘𝔍⇙ b" by auto
then show ?thesis by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
have tm_cf_discrete: "tm_cf_discrete α (𝔍⦇Arr⦈) ?L ℭ"
proof(intro tm_cf_discreteI)
show "𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈ ∈⇩∘ ℭ⦇Obj⦈" if "f ∈⇩∘ 𝔍⦇Arr⦈" for f
proof-
from that obtain a b where "f : a ↦⇘𝔍⇙ b" by auto
then show ?thesis
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
show "(λu∈⇩∘𝔍⦇Arr⦈. 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇u⦈⦈) ∈⇩∘ Vset α"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
show "ℛ⇩∘ (λu∈⇩∘𝔍⦇Arr⦈. ?L u) ∈⇩∘ Vset α"
proof-
have "ℛ⇩∘ (λu∈⇩∘𝔍⦇Arr⦈. ?L u) ⊆⇩∘ ℛ⇩∘ (𝔉⦇ObjMap⦈)"
proof(rule vrange_VLambda_vsubset)
fix f assume "f ∈⇩∘ 𝔍⦇Arr⦈"
then obtain a b where "f : a ↦⇘𝔍⇙ b" by auto
then show "𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈ ∈⇩∘ ℛ⇩∘ (𝔉⦇ObjMap⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros
)
qed
moreover have "ℛ⇩∘ (𝔉⦇ObjMap⦈) ∈⇩∘ Vset α"
by (auto intro: vrange_in_VsetI 𝔉.tm_cf_ObjMap_in_Vset)
ultimately show ?thesis by auto
qed
qed (auto simp: cat_small_cs_intros)
show "(λi∈⇩∘𝔍⦇Arr⦈. ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇i⦈⦈⦈) ∈⇩∘ Vset α"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
show "ℛ⇩∘ (λi∈⇩∘𝔍⦇Arr⦈. ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇i⦈⦈⦈) ∈⇩∘ Vset α"
proof-
have "ℛ⇩∘ (λi∈⇩∘𝔍⦇Arr⦈. ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇i⦈⦈⦈) ⊆⇩∘ ℛ⇩∘ (𝔉⦇ArrMap⦈)"
proof(rule vrange_VLambda_vsubset)
fix f assume "f ∈⇩∘ 𝔍⦇Arr⦈"
then obtain a b where f: "f : a ↦⇘𝔍⇙ b" by auto
then have "𝔍⦇CId⦈⦇b⦈ ∈⇩∘ 𝒟⇩∘ (𝔉⦇ArrMap⦈)"
by (auto intro: cat_cs_intros simp: cat_cs_simps)
moreover from f have
"ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈⦈ = 𝔉⦇ArrMap⦈⦇𝔍⦇CId⦈⦇b⦈⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
ultimately show "ℭ⦇CId⦈⦇𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈⦈ ∈⇩∘ ℛ⇩∘ (𝔉⦇ArrMap⦈)"
by (simp add: 𝔉.ArrMap.vsv_vimageI2)
qed
moreover have "ℛ⇩∘ (𝔉⦇ArrMap⦈) ∈⇩∘ Vset α"
by (force intro: vrange_in_VsetI 𝔉.tm_cf_ArrMap_in_Vset)
ultimately show ?thesis by auto
qed
qed (auto simp: cat_small_cs_intros)
qed (auto intro: cat_cs_intros)
from assms(4)[where A=‹?L›, OF this, simplified] obtain P⇩A π⇩A
where π⇩A: "π⇩A : P⇩A <⇩C⇩F⇩.⇩∏ ?L : 𝔍⦇Arr⦈ ↦↦⇩C⇘α⇙ ℭ"
by auto
interpret π⇩A: is_cat_obj_prod α ‹𝔍⦇Arr⦈› ?L ℭ P⇩A π⇩A by (rule π⇩A)
let ?F = ‹λu. 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇u⦈⦈› and ?f = ‹λu. π⇩O⦇NTMap⦈⦇𝔍⦇Cod⦈⦇u⦈⦈›
let ?π⇩O' = ‹ntcf_obj_prod_base ℭ (:⇩C (𝔍⦇Arr⦈)⦇Obj⦈) ?F P⇩O ?f›
have π⇩O': "?π⇩O' :
P⇩O <⇩C⇩F⇩.⇩c⇩o⇩n⇩e :→: (𝔍⦇Arr⦈) (λu. 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇u⦈⦈) ℭ :
:⇩C (𝔍⦇Arr⦈) ↦↦⇩C⇘α⇙ ℭ"
unfolding the_cat_discrete_components(1)
proof
(
intro
tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone
tm_cf_discrete
)
fix f assume "f ∈⇩∘ 𝔍⦇Arr⦈"
then obtain a b where "f : a ↦⇘𝔍⇙ b" by auto
then show "π⇩O⦇NTMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈ : P⇩O ↦⇘ℭ⇙ 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈"
by
(
cs_concl
cs_simp:
the_cat_discrete_components(1) cat_discrete_cs_simps cat_cs_simps
cs_intro: cat_cs_intros
)
qed (intro P⇩O)
from π⇩A.cat_obj_prod_unique_cone'[OF π⇩O'] obtain f'
where f': "f' : P⇩O ↦⇘ℭ⇙ P⇩A"
and π⇩O'_NTMap_app:
"⋀j. j ∈⇩∘ 𝔍⦇Arr⦈ ⟹ ?π⇩O'⦇NTMap⦈⦇j⦈ = π⇩A⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f'"
and unique_f':
"⟦
f'' : P⇩O ↦⇘ℭ⇙ P⇩A;
⋀j. j ∈⇩∘ 𝔍⦇Arr⦈ ⟹ ?π⇩O'⦇NTMap⦈⦇j⦈ = π⇩A⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ f''
⟧ ⟹ f'' = f'"
for f''
by metis
have π⇩O_NTMap_app_Cod:
"π⇩O⦇NTMap⦈⦇b⦈ = π⇩A⦇NTMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ f'" if "f : a ↦⇘𝔍⇙ b" for f a b
proof-
from that have "f ∈⇩∘ 𝔍⦇Arr⦈" by auto
from π⇩O'_NTMap_app[OF this] that show ?thesis
by
(
cs_prems
cs_simp: cat_cs_simps the_cat_discrete_components(1)
cs_intro: cat_cs_intros
)
qed
from this[symmetric] have π⇩A_NTMap_Comp_app:
"π⇩A⦇NTMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ (f' ∘⇩A⇘ℭ⇙ q) = π⇩O⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ q"
if "f : a ↦⇘𝔍⇙ b" and "q : c ↦⇘ℭ⇙ P⇩O" for q f a b c
using that f'
by (intro 𝔉.HomCod.cat_assoc_helper)
(
cs_concl
cs_simp:
cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
cs_intro: cat_cs_intros
)+
let ?g = ‹λu. 𝔉⦇ArrMap⦈⦇u⦈ ∘⇩A⇘ℭ⇙ π⇩O⦇NTMap⦈⦇𝔍⦇Dom⦈⦇u⦈⦈›
let ?π⇩O'' = ‹ntcf_obj_prod_base ℭ (:⇩C (𝔍⦇Arr⦈)⦇Obj⦈) ?F P⇩O ?g›
have π⇩O'': "?π⇩O'' : P⇩O <⇩C⇩F⇩.⇩c⇩o⇩n⇩e :→: (𝔍⦇Arr⦈) ?L ℭ : :⇩C (𝔍⦇Arr⦈) ↦↦⇩C⇘α⇙ ℭ"
unfolding the_cat_discrete_components(1)
proof
(
intro
tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone
tm_cf_discrete
)
show "𝔉⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ π⇩O⦇NTMap⦈⦇𝔍⦇Dom⦈⦇f⦈⦈ : P⇩O ↦⇘ℭ⇙ 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈"
if "f ∈⇩∘ 𝔍⦇Arr⦈" for f
proof-
from that obtain a b where "f : a ↦⇘𝔍⇙ b" by auto
then show ?thesis
by
(
cs_concl
cs_simp:
cat_cs_simps cat_discrete_cs_simps
the_cat_discrete_components(1)
cs_intro: cat_cs_intros
)
qed
qed (intro P⇩O)
from π⇩A.cat_obj_prod_unique_cone'[OF π⇩O''] obtain g'
where g': "g' : P⇩O ↦⇘ℭ⇙ P⇩A"
and π⇩O''_NTMap_app:
"⋀j. j ∈⇩∘ 𝔍⦇Arr⦈ ⟹ ?π⇩O''⦇NTMap⦈⦇j⦈ = π⇩A⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ g'"
and unique_g':
"⟦
g'' : P⇩O ↦⇘ℭ⇙ P⇩A;
⋀j. j ∈⇩∘ 𝔍⦇Arr⦈ ⟹ ?π⇩O''⦇NTMap⦈⦇j⦈ = π⇩A⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ g''
⟧ ⟹ g'' = g'"
for g''
by (metis (lifting))
have "𝔉⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ π⇩O⦇NTMap⦈⦇a⦈ = π⇩A⦇NTMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ g'"
if "f : a ↦⇘𝔍⇙ b" for f a b
proof-
from that have "f ∈⇩∘ 𝔍⦇Arr⦈" by auto
from π⇩O''_NTMap_app[OF this] that show ?thesis
by
(
cs_prems
cs_simp: cat_cs_simps the_cat_discrete_components(1)
cs_intro: cat_cs_intros
)
qed
then have π⇩O_NTMap_app_Dom:
"𝔉⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ (π⇩O⦇NTMap⦈⦇a⦈ ∘⇩A⇘ℭ⇙ q) =
(π⇩A⦇NTMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ g') ∘⇩A⇘ℭ⇙ q"
if "f : a ↦⇘𝔍⇙ b" and "q : c ↦⇘ℭ⇙ P⇩O" for q f a b c
using that g'
by (intro 𝔉.HomCod.cat_assoc_helper)
(
cs_concl
cs_simp:
cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
cs_intro: cat_cs_intros
)
from assms(2)[OF f' g'] obtain E ε where ε:
"ε : E <⇩C⇩F⇩.⇩e⇩q (P⇩O,P⇩A,g',f') : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
by clarsimp
interpret ε: is_cat_equalizer α P⇩O P⇩A g' f' ℭ E ε by (rule ε)
define μ where "μ =
[(λi∈⇩∘𝔍⦇Obj⦈. π⇩O⦇NTMap⦈⦇i⦈ ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈), cf_const 𝔍 ℭ E, 𝔉, 𝔍, ℭ]⇩∘"
have μ_components:
"μ⦇NTMap⦈ = (λi∈⇩∘𝔍⦇Obj⦈. π⇩O⦇NTMap⦈⦇i⦈ ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈)"
"μ⦇NTDom⦈ = cf_const 𝔍 ℭ E"
"μ⦇NTCod⦈ = 𝔉"
"μ⦇NTDGDom⦈ = 𝔍"
"μ⦇NTDGCod⦈ = ℭ"
unfolding μ_def nt_field_simps by (simp_all add: nat_omega_simps)
have [cat_cs_simps]:
"μ⦇NTMap⦈⦇i⦈ = π⇩O⦇NTMap⦈⦇i⦈ ∘⇩A⇘ℭ⇙ ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈" if "i ∈⇩∘ 𝔍⦇Obj⦈"
for i
using that unfolding μ_components by simp
have "μ : E <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
proof(intro is_cat_limitI')
show μ: "μ : E <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
show "vfsequence μ" unfolding μ_def by simp
show "vcard μ = 5⇩ℕ" unfolding μ_def by (simp add: nat_omega_simps)
show "cf_const 𝔍 ℭ E : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
show "𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ" by (cs_concl cs_intro: cat_cs_intros)
show "μ⦇NTMap⦈⦇a⦈ : cf_const 𝔍 ℭ E⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ 𝔉⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ 𝔍⦇Obj⦈" for a
using that
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_discrete_cs_simps
cat_parallel_cs_simps
the_cat_discrete_components(1)
cs_intro: cat_cs_intros cat_lim_cs_intros cat_parallel_cs_intros
)
show
"μ⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ cf_const 𝔍 ℭ E⦇ArrMap⦈⦇f⦈ =
𝔉⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ μ⦇NTMap⦈⦇a⦈"
if "f : a ↦⇘𝔍⇙ b" for a b f
using that ε g' f'
by
(
cs_concl
cs_simp:
cat_parallel_cs_simps
cat_cs_simps
the_cat_discrete_components(1)
π⇩O_NTMap_app_Cod
π⇩O_NTMap_app_Dom
ε.cat_eq_Comp_eq(1)
cs_intro: cat_lim_cs_intros cat_cs_intros cat_parallel_cs_intros
)
show "cf_const 𝔍 ℭ E : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
by
(
cs_concl cs_simp: cs_intro:
cat_lim_cs_intros cat_cs_intros cat_small_cs_intros
)
show "𝔉 : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
by (cs_concl cs_simp: cs_intro: cat_small_cs_intros)
qed (auto simp: μ_components cat_lim_cs_intros)
interpret μ: is_cat_cone α E 𝔍 ℭ 𝔉 μ by (rule μ)
show "∃!f'. f' : r' ↦⇘ℭ⇙ E ∧ u' = μ ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f'"
if "u' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ" for u' r'
proof-
interpret u': is_cat_cone α r' 𝔍 ℭ 𝔉 u' by (rule that)
let ?u' = ‹λj. u'⦇NTMap⦈⦇j⦈›
let ?π' = ‹ntcf_obj_prod_base ℭ (𝔍⦇Obj⦈) ?R r' ?u'›
have π'_NTMap_app: "?π'⦇NTMap⦈⦇j⦈ = u'⦇NTMap⦈⦇j⦈" if "j ∈⇩∘ 𝔍⦇Obj⦈" for j
using that
unfolding ntcf_obj_prod_base_components the_cat_discrete_components
by auto
have π': "?π' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e :→: (𝔍⦇Obj⦈) ?R ℭ : :⇩C (𝔍⦇Obj⦈) ↦↦⇩C⇘α⇙ ℭ"
unfolding the_cat_discrete_components(1)
proof(intro tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
show "tm_cf_discrete α (𝔍⦇Obj⦈) ?R ℭ"
proof(intro tm_cf_discreteI)
show "𝔉⦇ObjMap⦈⦇i⦈ ∈⇩∘ ℭ⦇Obj⦈" if "i ∈⇩∘ 𝔍⦇Obj⦈" for i
using that
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
(
auto intro:
cat_cs_intros
P⇩O
π⇩O.NTCod.tm_cf_ArrMap_in_Vset[unfolded the_cf_discrete_components]
π⇩O.NTCod.tm_cf_ObjMap_in_Vset[unfolded the_cf_discrete_components]
)
show "u'⦇NTMap⦈⦇j⦈ : r' ↦⇘ℭ⇙ 𝔉⦇ObjMap⦈⦇j⦈" if "j ∈⇩∘ 𝔍⦇Obj⦈" for j
using that by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: cat_lim_cs_intros)
from π⇩O.cat_obj_prod_unique_cone'[OF this] obtain h'
where h': "h' : r' ↦⇘ℭ⇙ P⇩O"
and π'_NTMap_app':
"⋀j. j ∈⇩∘ (𝔍⦇Obj⦈) ⟹ ?π'⦇NTMap⦈⦇j⦈ = π⇩O⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ h'"
and unique_h': "⋀h''.
⟦
h'' : r' ↦⇘ℭ⇙ P⇩O;
⋀j. j ∈⇩∘ (𝔍⦇Obj⦈) ⟹ ?π'⦇NTMap⦈⦇j⦈ = π⇩O⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ h''
⟧ ⟹ h'' = h'"
by metis
interpret π':
is_cat_cone α r' ‹:⇩C (𝔍⦇Obj⦈)› ℭ ‹:→: (𝔍⦇Obj⦈) (app (𝔉⦇ObjMap⦈)) ℭ› ?π'
by (rule π')
let ?u'' = ‹λu. u'⦇NTMap⦈⦇𝔍⦇Cod⦈⦇u⦈⦈›
let ?π'' = ‹ntcf_obj_prod_base ℭ (𝔍⦇Arr⦈) ?L r' ?u''›
have π''_NTMap_app: "?π''⦇NTMap⦈⦇f⦈ = u'⦇NTMap⦈⦇b⦈"
if "f : a ↦⇘𝔍⇙ b" for f a b
using that
unfolding ntcf_obj_prod_base_components the_cat_discrete_components
by (cs_concl cs_simp: V_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
have π'': "?π'' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e :→: (𝔍⦇Arr⦈) ?L ℭ : :⇩C (𝔍⦇Arr⦈) ↦↦⇩C⇘α⇙ ℭ"
unfolding the_cat_discrete_components(1)
proof
(
intro
tm_cf_discrete.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone
tm_cf_discrete
)
fix f assume "f ∈⇩∘ 𝔍⦇Arr⦈"
then obtain a b where "f : a ↦⇘𝔍⇙ b" by auto
then show "u'⦇NTMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈ : r' ↦⇘ℭ⇙ 𝔉⦇ObjMap⦈⦇𝔍⦇Cod⦈⦇f⦈⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (simp add: cat_lim_cs_intros)
from π⇩A.cat_obj_prod_unique_cone'[OF this] obtain h''
where h'': "h'' : r' ↦⇘ℭ⇙ P⇩A"
and π''_NTMap_app':
"⋀j. j ∈⇩∘ 𝔍⦇Arr⦈ ⟹ ?π''⦇NTMap⦈⦇j⦈ = π⇩A⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ h''"
and unique_h'': "⋀h'''.
⟦
h''' : r' ↦⇘ℭ⇙ P⇩A;
⋀j. j ∈⇩∘ 𝔍⦇Arr⦈ ⟹ ?π''⦇NTMap⦈⦇j⦈ = π⇩A⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ h'''
⟧ ⟹ h''' = h''"
by metis
interpret π'': is_cat_cone α r' ‹:⇩C (𝔍⦇Arr⦈)› ℭ ‹:→: (𝔍⦇Arr⦈) ?L ℭ› ?π''
by (rule π'')
have g'h'_f'h': "g' ∘⇩A⇘ℭ⇙ h' = f' ∘⇩A⇘ℭ⇙ h'"
proof-
from g' h' have g'h': "g' ∘⇩A⇘ℭ⇙ h' : r' ↦⇘ℭ⇙ P⇩A"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from f' h' have f'h': "f' ∘⇩A⇘ℭ⇙ h' : r' ↦⇘ℭ⇙ P⇩A"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have "?π''⦇NTMap⦈⦇f⦈ = π⇩A⦇NTMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ (g' ∘⇩A⇘ℭ⇙ h')"
if "f ∈⇩∘ 𝔍⦇Arr⦈" for f
proof-
from that obtain a b where f: "f : a ↦⇘𝔍⇙ b" by auto
then have "?π''⦇NTMap⦈⦇f⦈ = u'⦇NTMap⦈⦇b⦈"
by (cs_concl cs_simp: π''_NTMap_app cat_cs_simps)
also from f have "… = 𝔉⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ ?π'⦇NTMap⦈⦇a⦈"
by
(
cs_concl
cs_simp: π'_NTMap_app cat_lim_cs_simps cs_intro: cat_cs_intros
)
also from f g' h' have "… = π⇩A⦇NTMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ (g' ∘⇩A⇘ℭ⇙ h')"
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_discrete_cs_simps
the_cat_discrete_components(1)
π'_NTMap_app'
π⇩O_NTMap_app_Dom
cs_intro: cat_cs_intros
)
finally show ?thesis by simp
qed
from unique_h''[OF g'h' this, simplified] have g'h'_h'':
"g' ∘⇩A⇘ℭ⇙ h' = h''".
have "?π''⦇NTMap⦈⦇f⦈ = π⇩A⦇NTMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ (f' ∘⇩A⇘ℭ⇙ h')"
if "f ∈⇩∘ 𝔍⦇Arr⦈" for f
proof-
from that obtain a b where f: "f : a ↦⇘𝔍⇙ b" by auto
then have "?π''⦇NTMap⦈⦇f⦈ = u'⦇NTMap⦈⦇b⦈"
by (cs_concl cs_simp: π''_NTMap_app cat_cs_simps)
also from f have "… = ?π'⦇NTMap⦈⦇b⦈"
by (cs_concl cs_simp: π'_NTMap_app cs_intro: cat_cs_intros)
also from f have "… = π⇩O⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ h'"
by (cs_concl cs_simp: π'_NTMap_app' cs_intro: cat_cs_intros)
also from f g' h' have "… = (π⇩A⦇NTMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ f') ∘⇩A⇘ℭ⇙ h'"
by (cs_concl cs_simp: π⇩O_NTMap_app_Cod cs_intro: cat_cs_intros)
also from that f' h' have "… = π⇩A⦇NTMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ (f' ∘⇩A⇘ℭ⇙ h')"
by
(
cs_concl
cs_simp: cat_cs_simps the_cat_discrete_components(1)
cs_intro: cat_cs_intros
)
finally show ?thesis by simp
qed
from unique_h''[OF f'h' this, simplified] have f'h'_h'':
"f' ∘⇩A⇘ℭ⇙ h' = h''".
from g'h'_h'' f'h'_h'' show ?thesis by simp
qed
let ?II = ‹↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L›
and ?II_II = ‹↑↑→↑↑ ℭ 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L P⇩O P⇩A g' f'›
define ε' where "ε' =
[
(λf∈⇩∘?II⦇Obj⦈. (f = 𝔞⇩P⇩L ? h' : (f' ∘⇩A⇘ℭ⇙ h'))),
cf_const ?II ℭ r',
?II_II,
?II,
ℭ
]⇩∘"
have ε'_components:
"ε'⦇NTMap⦈ = (λf∈⇩∘?II⦇Obj⦈. (f = 𝔞⇩P⇩L ? h' : (f' ∘⇩A⇘ℭ⇙ h')))"
"ε'⦇NTDom⦈ = cf_const ?II ℭ r'"
"ε'⦇NTCod⦈ = ?II_II"
"ε'⦇NTDGDom⦈ = ?II"
"ε'⦇NTDGCod⦈ = ℭ"
unfolding ε'_def nt_field_simps by (simp_all add: nat_omega_simps)
have ε'_NTMap_app_I2: "ε'⦇NTMap⦈⦇x⦈ = h'" if "x = 𝔞⇩P⇩L" for x
proof-
have "x ∈⇩∘ ?II⦇Obj⦈"
unfolding that by (cs_concl cs_intro: cat_parallel_cs_intros)
then show ?thesis unfolding ε'_components that by simp
qed
have ε'_NTMap_app_sI2: "ε'⦇NTMap⦈⦇x⦈ = f' ∘⇩A⇘ℭ⇙ h'" if "x = 𝔟⇩P⇩L" for x
proof-
have "x ∈⇩∘ ?II⦇Obj⦈"
unfolding that by (cs_concl cs_intro: cat_parallel_cs_intros)
with ε.cat_parallel_𝔞𝔟 show ?thesis
unfolding ε'_components by (cs_concl cs_simp: V_cs_simps that)
qed
interpret par: cf_parallel α 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L P⇩O P⇩A g' f' ℭ
by (intro cf_parallelI cat_parallelI)
(
simp_all add:
cat_cs_intros cat_parallel_cs_intros cat_PL_ineq[symmetric]
)
have "ε' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ?II_II : ?II ↦↦⇩C⇘α⇙ ℭ"
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
show "vfsequence ε'" unfolding ε'_def by auto
show "vcard ε' = 5⇩ℕ" unfolding ε'_def by (simp add: nat_omega_simps)
from h' show "cf_const (?II) ℭ r' : ?II ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "?II_II : ?II ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_parallel_cs_simps cs_intro: cat_cs_intros)
from h' show "ε'⦇NTMap⦈⦇a⦈ :
cf_const ?II ℭ r'⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ?II_II⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ ?II⦇Obj⦈" for a
using that
by (elim the_cat_parallel_ObjE; simp only:)
(
cs_concl
cs_simp:
ε'_NTMap_app_I2 ε'_NTMap_app_sI2
cat_cs_simps cat_parallel_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
from h' f' g'h'_f'h' show
"ε'⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ cf_const ?II ℭ r'⦇ArrMap⦈⦇f⦈ =
?II_II⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ ε'⦇NTMap⦈⦇a⦈"
if "f : a ↦⇘?II⇙ b" for a b f
using that
by (elim ε.the_cat_parallel_is_arrE; simp only:)
(
cs_concl
cs_intro: cat_cs_intros cat_parallel_cs_intros
cs_simp:
cat_cs_simps
cat_parallel_cs_simps
ε'_NTMap_app_I2
ε'_NTMap_app_sI2
)+
qed
(
simp add: ε'_components |
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_lim_cs_intros cat_cs_intros cat_small_cs_intros
)+
from ε.cat_eq_unique_cone[OF this] obtain t'
where t': "t' : r' ↦⇘ℭ⇙ E"
and ε'_NTMap_app: "ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ t'"
and unique_t':
"⟦ t'' : r' ↦⇘ℭ⇙ E; ε'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ t''⟧ ⟹
t'' = t'"
for t''
by metis
show "∃!f'. f' : r' ↦⇘ℭ⇙ E ∧ u' = μ ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ f'"
proof(intro ex1I conjI; (elim conjE)?, (rule t')?)
show [symmetric, cat_cs_simps]: "u' = μ ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ t'"
proof(rule ntcf_eqI[OF u'.is_ntcf_axioms])
from t' show
"μ ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ t' : cf_const 𝔍 ℭ r' ↦⇩C⇩F 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "u'⦇NTMap⦈ = (μ ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ t')⦇NTMap⦈"
proof(rule vsv_eqI)
show "vsv ((μ ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ t')⦇NTMap⦈)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from t' show
"𝒟⇩∘ (u'⦇NTMap⦈) = 𝒟⇩∘ ((μ ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ t')⦇NTMap⦈)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "u'⦇NTMap⦈⦇a⦈ = (μ ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ t')⦇NTMap⦈⦇a⦈"
if "a ∈⇩∘ 𝒟⇩∘ (u'⦇NTMap⦈)" for a
proof-
from that have "a ∈⇩∘ 𝔍⦇Obj⦈" by (cs_prems cs_simp: cat_cs_simps)
with t' show "u'⦇NTMap⦈⦇a⦈ = (μ ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ t')⦇NTMap⦈⦇a⦈"
by
(
cs_concl
cs_simp:
cat_cs_simps
π'_NTMap_app
cat_parallel_cs_simps
the_cat_discrete_components(1)
ε'_NTMap_app[symmetric]
ε'_NTMap_app_I2
π'_NTMap_app'[symmetric]
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
qed
qed auto
qed simp_all
fix t'' assume prems':
"t'' : r' ↦⇘ℭ⇙ E" "u' = μ ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ t''"
then have u'_NTMap_app_x:
"u'⦇NTMap⦈⦇x⦈ = (μ ∙⇩N⇩T⇩C⇩F ntcf_const 𝔍 ℭ t'')⦇NTMap⦈⦇x⦈"
for x
by simp
have "?π'⦇NTMap⦈⦇j⦈ = π⇩O⦇NTMap⦈⦇j⦈ ∘⇩A⇘ℭ⇙ (ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ t'')"
if "j ∈⇩∘ 𝔍⦇Obj⦈" for j
using u'_NTMap_app_x[of j] prems'(1) that
by
(
cs_prems
cs_simp:
cat_cs_simps
cat_discrete_cs_simps
cat_parallel_cs_simps
the_cat_discrete_components(1)
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
(simp add: π'_NTMap_app[OF that, symmetric])
moreover from prems'(1) have "ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ t'' : r' ↦⇘ℭ⇙ P⇩O"
by
(
cs_concl
cs_simp: cat_cs_simps cat_parallel_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
ultimately have [cat_cs_simps]:
"ε⦇NTMap⦈⦇𝔞⇩P⇩L⦈ ∘⇩A⇘ℭ⇙ t'' = h'"
by (intro unique_h') simp
show "t'' = t'"
by (rule unique_t', intro prems'(1))
(cs_concl cs_simp: ε'_NTMap_app_I2 cat_cs_simps)
qed
qed
qed
then show ?thesis using that by clarsimp
qed
lemma cat_colimit_of_cat_prod_obj_and_cat_coequalizer:
assumes "𝔉 : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "⋀𝔞 𝔟 𝔤 𝔣. ⟦ 𝔣 : 𝔟 ↦⇘ℭ⇙ 𝔞; 𝔤 : 𝔟 ↦⇘ℭ⇙ 𝔞 ⟧ ⟹
∃E ε. ε : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
and "⋀A. tm_cf_discrete α (𝔍⦇Obj⦈) A ℭ ⟹
∃P π. π : A >⇩C⇩F⇩.⇩∐ P : 𝔍⦇Obj⦈ ↦↦⇩C⇘α⇙ ℭ"
and "⋀A. tm_cf_discrete α (𝔍⦇Arr⦈) A ℭ ⟹
∃P π. π : A >⇩C⇩F⇩.⇩∐ P : 𝔍⦇Arr⦈ ↦↦⇩C⇘α⇙ ℭ"
obtains r u where "u : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
proof-
interpret 𝔉: is_tm_functor α 𝔍 ℭ 𝔉 by (rule assms(1))
have "∃E ε. ε : E <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ op_cat ℭ"
if "𝔣 : 𝔟 ↦⇘ℭ⇙ 𝔞" "𝔤 : 𝔟 ↦⇘ℭ⇙ 𝔞" for 𝔞 𝔟 𝔤 𝔣
proof-
from assms(2)[OF that(1,2)] obtain E ε
where ε: "ε : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
by clarsimp
interpret ε: is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε by (rule ε)
from ε.is_cat_equalizer_op[unfolded cat_op_simps] show ?thesis by auto
qed
moreover have "∃P π. π : P <⇩C⇩F⇩.⇩∏ A : 𝔍⦇Obj⦈ ↦↦⇩C⇘α⇙ op_cat ℭ"
if "tm_cf_discrete α (𝔍⦇Obj⦈) A (op_cat ℭ)" for A
proof-
interpret tm_cf_discrete α ‹𝔍⦇Obj⦈› A ‹op_cat ℭ› by (rule that)
from assms(3)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P π
where π: "π : A >⇩C⇩F⇩.⇩∐ P : 𝔍⦇Obj⦈ ↦↦⇩C⇘α⇙ ℭ"
by clarsimp
interpret π: is_cat_obj_coprod α ‹𝔍⦇Obj⦈› A ℭ P π by (rule π)
from π.is_cat_obj_prod_op show ?thesis by auto
qed
moreover have "∃P π. π : P <⇩C⇩F⇩.⇩∏ A : 𝔍⦇Arr⦈ ↦↦⇩C⇘α⇙ op_cat ℭ"
if "tm_cf_discrete α (𝔍⦇Arr⦈) A (op_cat ℭ)" for A
proof-
interpret tm_cf_discrete α ‹𝔍⦇Arr⦈› A ‹op_cat ℭ› by (rule that)
from assms(4)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P π
where π: "π : A >⇩C⇩F⇩.⇩∐ P : 𝔍⦇Arr⦈ ↦↦⇩C⇘α⇙ ℭ"
by clarsimp
interpret π: is_cat_obj_coprod α ‹𝔍⦇Arr⦈› A ℭ P π by (rule π)
from π.is_cat_obj_prod_op show ?thesis by auto
qed
ultimately obtain u r where u:
"u : r <⇩C⇩F⇩.⇩l⇩i⇩m op_cf 𝔉 : op_cat 𝔍 ↦↦⇩C⇘α⇙ op_cat ℭ"
by
(
rule cat_limit_of_cat_prod_obj_and_cat_equalizer[
OF 𝔉.is_tm_functor_op, unfolded cat_op_simps
]
)
interpret u: is_cat_limit α ‹op_cat 𝔍› ‹op_cat ℭ› ‹op_cf 𝔉› r u by (rule u)
from u.is_cat_colimit_op[unfolded cat_op_simps] that show ?thesis by simp
qed
text‹\newpage›
end
Theory CZH_UCAT_Complete
section‹Completeness for categories›
theory CZH_UCAT_Complete
imports CZH_UCAT_Limit
begin
subsection‹Small-complete category›
subsubsection‹Definition and elementary properties›
locale cat_small_complete = category α ℭ for α ℭ +
assumes cat_small_complete:
"⋀𝔉 𝔍. 𝔉 : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ ⟹ ∃u r. u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
locale cat_small_cocomplete = category α ℭ for α ℭ +
assumes cat_small_cocomplete:
"⋀𝔉 𝔍. 𝔉 : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ ⟹ ∃u r. u : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
text‹Rules.›
mk_ide rf cat_small_complete_def[unfolded cat_small_complete_axioms_def]
|intro cat_small_completeI|
|dest cat_small_completeD[dest]|
|elim cat_small_completeE[elim]|
lemma cat_small_completeE'[elim]:
assumes "cat_small_complete α ℭ" and "𝔉 : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
obtains u r where "u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
using assms by auto
mk_ide rf cat_small_cocomplete_def[unfolded cat_small_cocomplete_axioms_def]
|intro cat_small_cocompleteI|
|dest cat_small_cocompleteD[dest]|
|elim cat_small_cocompleteE[elim]|
lemma cat_small_cocompleteE'[elim]:
assumes "cat_small_cocomplete α ℭ" and "𝔉 : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
obtains u r where "u : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
using assms by auto
subsubsection‹Duality›
lemma (in cat_small_complete) cat_small_cocomplete_op[cat_op_intros]:
"cat_small_cocomplete α (op_cat ℭ)"
proof(intro cat_small_cocompleteI)
fix 𝔉 𝔍 assume "𝔉 : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ op_cat ℭ"
then interpret 𝔉: is_tm_functor α 𝔍 ‹op_cat ℭ› 𝔉 .
from cat_small_complete[OF 𝔉.is_tm_functor_op[unfolded cat_op_simps]]
obtain u r where u: "u : r <⇩C⇩F⇩.⇩l⇩i⇩m op_cf 𝔉 : op_cat 𝔍 ↦↦⇩C⇘α⇙ ℭ"
by auto
then interpret u: is_cat_limit α ‹op_cat 𝔍› ℭ ‹op_cf 𝔉› r u .
from u.is_cat_colimit_op[unfolded cat_op_simps] show
"∃u r. u : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : 𝔍 ↦↦⇩C⇘α⇙ op_cat ℭ"
by auto
qed (auto intro: cat_cs_intros)
lemmas [cat_op_intros] = cat_small_complete.cat_small_cocomplete_op
lemma (in cat_small_cocomplete) cat_small_complete_op[cat_op_intros]:
"cat_small_complete α (op_cat ℭ)"
proof(intro cat_small_completeI)
fix 𝔉 𝔍 assume prems: "𝔉 : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ op_cat ℭ"
then interpret 𝔉: is_tm_functor α 𝔍 ‹op_cat ℭ› 𝔉 .
from cat_small_cocomplete[OF 𝔉.is_tm_functor_op[unfolded cat_op_simps]]
obtain u r where u: "u : op_cf 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : op_cat 𝔍 ↦↦⇩C⇘α⇙ ℭ"
by auto
interpret u: is_cat_colimit α ‹op_cat 𝔍› ℭ ‹op_cf 𝔉› r u by (rule u)
from u.is_cat_limit_op[unfolded cat_op_simps] show
"∃u r. u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ op_cat ℭ"
by auto
qed (auto intro: cat_cs_intros)
lemmas [cat_op_intros] = cat_small_cocomplete.cat_small_complete_op
subsubsection‹A category with equalizers and small products is small-complete›
lemma (in category) cat_small_complete_if_eq_and_obj_prod:
assumes "⋀𝔞 𝔟 𝔤 𝔣. ⟦ 𝔣 : 𝔞 ↦⇘ℭ⇙ 𝔟; 𝔤 : 𝔞 ↦⇘ℭ⇙ 𝔟 ⟧ ⟹
∃E ε. ε : E <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
and "⋀A I. tm_cf_discrete α I A ℭ ⟹ ∃P π. π : P <⇩C⇩F⇩.⇩∏ A : I ↦↦⇩C⇘α⇙ ℭ"
shows "cat_small_complete α ℭ"
proof(intro cat_small_completeI)
fix 𝔉 𝔍 assume prems: "𝔉 : 𝔍 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
then interpret 𝔉: is_tm_functor α 𝔍 ℭ 𝔉 .
show "∃u r. u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
by (rule cat_limit_of_cat_prod_obj_and_cat_equalizer[OF prems assms(1)])
(auto intro: assms(2))
qed (auto simp: cat_cs_intros)
lemma (in category) cat_small_cocomplete_if_eq_and_obj_prod:
assumes "⋀𝔞 𝔟 𝔤 𝔣. ⟦ 𝔣 : 𝔟 ↦⇘ℭ⇙ 𝔞; 𝔤 : 𝔟 ↦⇘ℭ⇙ 𝔞 ⟧ ⟹
∃E ε. ε : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
and "⋀A I. tm_cf_discrete α I A ℭ ⟹ ∃P π. π : A >⇩C⇩F⇩.⇩∐ P : I ↦↦⇩C⇘α⇙ ℭ"
shows "cat_small_cocomplete α ℭ"
proof-
have "∃E ε. ε : E <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ op_cat ℭ"
if "𝔣 : 𝔟 ↦⇘ℭ⇙ 𝔞" and "𝔤 : 𝔟 ↦⇘ℭ⇙ 𝔞" for 𝔞 𝔟 𝔤 𝔣
proof-
from assms(1)[OF that] obtain ε E where
ε: "ε : (𝔞,𝔟,𝔤,𝔣) >⇩C⇩F⇩.⇩c⇩o⇩e⇩q E : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ ℭ"
by clarsimp
interpret ε: is_cat_coequalizer α 𝔞 𝔟 𝔤 𝔣 ℭ E ε by (rule ε)
from ε.is_cat_equalizer_op show ?thesis by auto
qed
moreover have "∃P π. π : P <⇩C⇩F⇩.⇩∏ A : I ↦↦⇩C⇘α⇙ op_cat ℭ"
if "tm_cf_discrete α I A (op_cat ℭ)" for A I
proof-
interpret tm_cf_discrete α I A ‹op_cat ℭ› by (rule that)
from assms(2)[OF tm_cf_discrete_op[unfolded cat_op_simps]] obtain P π
where π: "π : A >⇩C⇩F⇩.⇩∐ P : I ↦↦⇩C⇘α⇙ ℭ"
by auto
interpret π: is_cat_obj_coprod α I A ℭ P π by (rule π)
from π.is_cat_obj_prod_op show ?thesis by auto
qed
ultimately interpret cat_small_complete α ‹op_cat ℭ›
by
(
rule category.cat_small_complete_if_eq_and_obj_prod[
OF category_op, unfolded cat_op_simps
]
)
show ?thesis by (rule cat_small_cocomplete_op[unfolded cat_op_simps])
qed
subsection‹Finite-complete category›
locale cat_finite_complete = category α ℭ for α ℭ +
assumes cat_finite_complete:
"⋀𝔉 𝔍. ⟦ finite_category α 𝔍; 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ ⟧ ⟹
∃u r. u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
locale cat_finite_cocomplete = category α ℭ for α ℭ +
assumes cat_finite_cocomplete:
"⋀𝔉 𝔍. ⟦ finite_category α 𝔍; 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ ⟧ ⟹
∃u r. u : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
text‹Rules.›
mk_ide rf cat_finite_complete_def[unfolded cat_finite_complete_axioms_def]
|intro cat_finite_completeI|
|dest cat_finite_completeD[dest]|
|elim cat_finite_completeE[elim]|
lemma cat_finite_completeE'[elim]:
assumes "cat_finite_complete α ℭ"
and "finite_category α 𝔍"
and "𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
obtains u r where "u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
using assms by auto
mk_ide rf cat_finite_cocomplete_def[unfolded cat_finite_cocomplete_axioms_def]
|intro cat_finite_cocompleteI|
|dest cat_finite_cocompleteD[dest]|
|elim cat_finite_cocompleteE[elim]|
lemma cat_finite_cocompleteE'[elim]:
assumes "cat_finite_cocomplete α ℭ"
and "finite_category α 𝔍"
and "𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
obtains u r where "u : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
using assms by auto
text‹Elementary properties.›
sublocale cat_small_complete ⊆ cat_finite_complete
proof(intro cat_finite_completeI)
fix 𝔉 𝔍 assume prems: "finite_category α 𝔍" "𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
interpret 𝔉: is_functor α 𝔍 ℭ 𝔉 by (rule prems(2))
from cat_small_complete_axioms show "∃u r. u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
by (auto intro: 𝔉.cf_is_tm_functor_if_HomDom_finite_category[OF prems(1)])
qed (auto intro: cat_cs_intros)
sublocale cat_small_cocomplete ⊆ cat_finite_cocomplete
proof(intro cat_finite_cocompleteI)
fix 𝔉 𝔍 assume prems: "finite_category α 𝔍" "𝔉 : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
interpret 𝔉: is_functor α 𝔍 ℭ 𝔉 by (rule prems(2))
from cat_small_cocomplete_axioms show "∃u r. u : 𝔉 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m r : 𝔍 ↦↦⇩C⇘α⇙ ℭ"
by (auto intro: 𝔉.cf_is_tm_functor_if_HomDom_finite_category[OF prems(1)])
qed (auto intro: cat_cs_intros)
subsection‹Discrete functor with tiny maps to the category ‹Set››
lemma (in 𝒵) tm_cf_discrete_cat_Set_if_VLambda_in_Vset:
assumes "VLambda I F ∈⇩∘ Vset α"
shows "tm_cf_discrete α I F (cat_Set α)"
proof(intro tm_cf_discreteI)
from assms have vrange_F_in_Vset: "ℛ⇩∘ (VLambda I F) ∈⇩∘ Vset α"
by (auto intro: vrange_in_VsetI)
show "(λi∈⇩∘I. cat_Set α⦇CId⦈⦇F i⦈) ∈⇩∘ Vset α"
proof(rule vbrelation.vbrelation_Limit_in_VsetI)
from assms show "𝒟⇩∘ (λi∈⇩∘I. cat_Set α⦇CId⦈⦇F i⦈) ∈⇩∘ Vset α"
by (metis vdomain_VLambda vdomain_in_VsetI)
define Q where
"Q i =
(
if i = 0
then VPow ((⋃⇩∘i∈⇩∘I. F i) ×⇩∘ (⋃⇩∘i∈⇩∘I. F i))
else set (F ` elts I)
)"
for i :: V
have "ℛ⇩∘ (λi∈⇩∘I. cat_Set α⦇CId⦈⦇F i⦈) ⊆⇩∘ (∏⇩∘i∈⇩∘ set {0, 1⇩ℕ, 2⇩ℕ}. Q i)"
proof(intro vsubsetI, unfold cat_Set_components)
fix y assume "y ∈⇩∘ ℛ⇩∘ (λi∈⇩∘I. VLambda (Vset α) id_Set⦇F i⦈)"
then obtain i where i: "i ∈⇩∘ I"
and y_def: "y = VLambda (Vset α) id_Set⦇F i⦈"
by auto
from i have "F i ∈⇩∘ ℛ⇩∘ (VLambda I F)" by auto
with vrange_F_in_Vset have "F i ∈⇩∘ Vset α" by auto
then have y_def: "y = id_Set (F i)" unfolding y_def by auto
show "y ∈⇩∘ (∏⇩∘i∈⇩∘set {0, 1⇩ℕ, 2⇩ℕ}. Q i)"
unfolding y_def
proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
show "𝒟⇩∘ (id_Rel (F i)) = set {0, 1⇩ℕ, 2⇩ℕ}"
by (simp add: id_Rel_def incl_Rel_def three nat_omega_simps)
fix j assume "j ∈⇩∘ set {0, 1⇩ℕ, 2⇩ℕ}"
then consider ‹j = 0› | ‹j = 1⇩ℕ› | ‹j = 2⇩ℕ› by auto
then show "id_Rel (F i)⦇j⦈ ∈⇩∘ Q j"
proof cases
case 1
from i show ?thesis
unfolding 1
by
(
subst arr_field_simps(1)[symmetric],
unfold id_Rel_components Q_def
)
force
next
case 2
from i show ?thesis
unfolding 2
by
(
subst arr_field_simps(2)[symmetric],
unfold id_Rel_components Q_def
)
auto
next
case 3
from i show ?thesis
unfolding 3
by
(
subst arr_field_simps(3)[symmetric],
unfold id_Rel_components Q_def
)
auto
qed
qed (auto simp: id_Rel_def cat_Set_cs_intros)
qed
moreover have "(∏⇩∘i∈⇩∘ set {0, 1⇩ℕ, 2⇩ℕ}. Q i) ∈⇩∘ Vset α"
proof(rule Limit_vproduct_in_VsetI)
show "set {0, 1⇩ℕ, 2⇩ℕ} ∈⇩∘ Vset α" unfolding three[symmetric] by simp
from assms have "VPow ((⋃⇩∘i∈⇩∘I. F i) ×⇩∘ (⋃⇩∘i∈⇩∘I. F i)) ∈⇩∘ Vset α"
by
(
intro
Limit_VPow_in_VsetI
Limit_vtimes_in_VsetI
Limit_vifunion_in_Vset_if_VLambda_in_VsetI
)
auto
then show "Q i ∈⇩∘ Vset α" if "i ∈⇩∘ set {0, 1⇩ℕ, 2⇩ℕ}" for i
using that vrange_VLambda
by (auto intro!: vrange_F_in_Vset simp: Q_def nat_omega_simps)
qed auto
ultimately show "ℛ⇩∘ (λi∈⇩∘I. cat_Set α⦇CId⦈⦇F i⦈) ∈⇩∘ Vset α"
by (meson vsubset_in_VsetI)
qed auto
fix i assume prems: "i ∈⇩∘ I"
from assms have "ℛ⇩∘ (VLambda I F) ∈⇩∘ Vset α" by (auto simp: vrange_in_VsetI)
moreover from prems have "F i ∈⇩∘ ℛ⇩∘ (VLambda I F)" by auto
ultimately show "F i ∈⇩∘ cat_Set α⦇Obj⦈" unfolding cat_Set_components by auto
qed (cs_concl cs_intro: cat_cs_intros assms)+
subsection‹Product cone for the category ‹Set››
subsubsection‹Definition and elementary properties›
definition ntcf_Set_obj_prod :: "V ⇒ V ⇒ (V ⇒ V) ⇒ V"
where "ntcf_Set_obj_prod α I F = ntcf_obj_prod_base
(cat_Set α) I F (∏⇩∘i∈⇩∘I. F i) (λi. vprojection_arrow I F i)"
text‹Components.›
lemma ntcf_Set_obj_prod_components:
shows "ntcf_Set_obj_prod α I F⦇NTMap⦈ =
(λi∈⇩∘:⇩C I⦇Obj⦈. vprojection_arrow I F i)"
and "ntcf_Set_obj_prod α I F⦇NTDom⦈ =
cf_const (:⇩C I) (cat_Set α) (∏⇩∘i∈⇩∘I. F i)"
and "ntcf_Set_obj_prod α I F⦇NTCod⦈ = :→: I F (cat_Set α)"
and "ntcf_Set_obj_prod α I F⦇NTDGDom⦈ = :⇩C I"
and "ntcf_Set_obj_prod α I F⦇NTDGCod⦈ = cat_Set α"
unfolding ntcf_Set_obj_prod_def ntcf_obj_prod_base_components by simp_all
subsubsection‹Natural transformation map›
mk_VLambda ntcf_Set_obj_prod_components(1)
|vsv ntcf_Set_obj_prod_NTMap_vsv[cat_cs_intros]|
|vdomain ntcf_Set_obj_prod_NTMap_vdomain[cat_cs_simps]|
|app ntcf_Set_obj_prod_NTMap_app[cat_cs_simps]|
subsubsection‹Product cone for the category ‹Set› is a universal cone›
lemma (in 𝒵) tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod:
assumes "VLambda I F ∈⇩∘ Vset α"
shows "ntcf_Set_obj_prod α I F : (∏⇩∘i∈⇩∘I. F i) <⇩C⇩F⇩.⇩∏ F : I ↦↦⇩C⇘α⇙ cat_Set α"
proof(intro is_cat_obj_prodI is_cat_limitI')
interpret Set: tm_cf_discrete α I F ‹cat_Set α›
by (rule tm_cf_discrete_cat_Set_if_VLambda_in_Vset[OF assms])
let ?F = ‹ntcf_Set_obj_prod α I F›
show "cf_discrete α I F (cat_Set α)"
by (auto simp: cat_small_discrete_cs_intros)
show F_is_cat_cone: "?F :
(∏⇩∘i∈⇩∘I. F i) <⇩C⇩F⇩.⇩c⇩o⇩n⇩e :→: I F (cat_Set α) : :⇩C I ↦↦⇩C⇘α⇙ cat_Set α"
unfolding ntcf_Set_obj_prod_def
proof(rule Set.tm_cf_discrete_ntcf_obj_prod_base_is_cat_cone)
show "(∏⇩∘i∈⇩∘I. F i) ∈⇩∘ cat_Set α⦇Obj⦈"
unfolding cat_Set_components
by
(
intro
Limit_vproduct_in_Vset_if_VLambda_in_VsetI
Set.tm_cf_discrete_ObjMap_in_Vset
)
auto
qed (intro vprojection_arrow_is_arr Set.tm_cf_discrete_ObjMap_in_Vset)
interpret F: is_cat_cone
α ‹∏⇩∘i∈⇩∘I. F i› ‹:⇩C I› ‹cat_Set α› ‹:→: I F (cat_Set α)› ‹?F›
by (rule F_is_cat_cone)
fix π' P' assume prems:
"π' : P' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e :→: I F (cat_Set α) : :⇩C I ↦↦⇩C⇘α⇙ cat_Set α"
let ?π'i = ‹λi. π'⦇NTMap⦈⦇i⦈›
let ?up' = ‹cat_Set_obj_prod_up I F P' ?π'i›
interpret π': is_cat_cone α P' ‹:⇩C I› ‹cat_Set α› ‹:→: I F (cat_Set α)› π'
by (rule prems(1))
show "∃!f'.
f' : P' ↦⇘cat_Set α⇙ (∏⇩∘i∈⇩∘I. F i) ∧
π' = ?F ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C I) (cat_Set α) f'"
proof(intro ex1I conjI; (elim conjE)?)
show up': "?up' : P' ↦⇘cat_Set α⇙ (∏⇩∘i∈⇩∘I. F i)"
proof(rule cat_Set_obj_prod_up_cat_Set_is_arr)
show "P' ∈⇩∘ Vset α" by (auto intro: cat_cs_intros cat_lim_cs_intros)
fix i assume "i ∈⇩∘ I"
then show "π'⦇NTMap⦈⦇i⦈ : P' ↦⇘cat_Set α⇙ F i"
by
(
cs_concl
cs_simp:
the_cat_discrete_components(1)
cat_cs_simps cat_discrete_cs_simps
cs_intro: cat_cs_intros
)
qed (rule assms)
then have P': "P' ∈⇩∘ Vset α"
by (auto intro: cat_cs_intros cat_lim_cs_intros)
have π'i_i: "?π'i i : P' ↦⇘cat_Set α⇙ F i" if "i ∈⇩∘ I" for i
using
π'.ntcf_NTMap_is_arr[unfolded the_cat_discrete_components(1), OF that]
that
by
(
cs_prems cs_simp:
cat_cs_simps cat_discrete_cs_simps the_cat_discrete_components(1)
)
from cat_Set_obj_prod_up_cat_Set_is_arr[OF P' assms(1) π'i_i] have π'i:
"cat_Set_obj_prod_up I F P' ?π'i : P' ↦⇘cat_Set α⇙ (∏⇩∘i∈⇩∘I. F i)".
show "π' = ?F ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C I) (cat_Set α) ?up'"
proof(rule ntcf_eqI, rule π'.is_ntcf_axioms)
from F_is_cat_cone π'i show
"?F ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C I) (cat_Set α) ?up' :
cf_const (:⇩C I) (cat_Set α) P' ↦⇩C⇩F :→: I F (cat_Set α) :
:⇩C I ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_intro: cat_cs_intros)
have dom_lhs: "𝒟⇩∘ (π'⦇NTMap⦈) = :⇩C I⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
from F_is_cat_cone π'i have dom_rhs:
"𝒟⇩∘ ((?F ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C I) (cat_Set α) ?up')⦇NTMap⦈) = :⇩C I⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "π'⦇NTMap⦈ = (?F ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C I) (cat_Set α) ?up')⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix i assume prems': "i ∈⇩∘ :⇩C I⦇Obj⦈"
then have i: "i ∈⇩∘ I" unfolding the_cat_discrete_components by simp
have [cat_cs_simps]:
"vprojection_arrow I F i ∘⇩A⇘cat_Set α⇙ ?up' = π'⦇NTMap⦈⦇i⦈"
by
(
rule pdg_dghm_comp_dghm_proj_dghm_up[
OF P' assms π'i_i i, symmetric
]
)
auto
from π'i prems' show "π'⦇NTMap⦈⦇i⦈ =
(?F ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C I) (cat_Set α) ?up')⦇NTMap⦈⦇i⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Rel_cs_simps cs_intro: cat_cs_intros
)
qed (auto simp: cat_cs_intros)
qed simp_all
fix f' assume prems:
"f' : P' ↦⇘cat_Set α⇙ (∏⇩∘i∈⇩∘I. F i)"
"π' = ?F ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C I) (cat_Set α) f'"
from prems(2) have π'_eq_F_f': "π'⦇NTMap⦈⦇i⦈⦇ArrVal⦈⦇a⦈ =
(?F ∙⇩N⇩T⇩C⇩F ntcf_const (:⇩C I) (cat_Set α) f')⦇NTMap⦈⦇i⦈⦇ArrVal⦈⦇a⦈"
if "i ∈⇩∘ I" and "a ∈⇩∘ P'" for i a
by simp
have [cat_Set_cs_simps]: "π'⦇NTMap⦈⦇i⦈⦇ArrVal⦈⦇a⦈ = f'⦇ArrVal⦈⦇a⦈⦇i⦈"
if "i ∈⇩∘ I" and "a ∈⇩∘ P'" for i a
using
π'_eq_F_f'[OF that]
assms prems that
vprojection_arrow_is_arr[OF that(1) assms]
by
(
cs_prems
cs_simp:
cat_Set_cs_simps
cat_cs_simps
vprojection_arrow_app
the_cat_discrete_components(1)
cs_intro: cat_Set_cs_intros cat_cs_intros
)
note f' = cat_Set_is_arrD[OF prems(1)]
note up' = cat_Set_is_arrD[OF up']
interpret f': arr_Set α f' by (rule f'(1))
interpret u': arr_Set α ‹(cat_Set_obj_prod_up I F P' (app (π'⦇NTMap⦈)))›
by (rule up'(1))
show "f' = ?up'"
proof(rule arr_Set_eqI[of α])
have dom_lhs: "𝒟⇩∘ (f'⦇ArrVal⦈) = P'"
by (simp add: cat_Set_cs_simps cat_cs_simps f')
have dom_rhs:
"𝒟⇩∘ (cat_Set_obj_prod_up I F P' (app (π'⦇NTMap⦈))⦇ArrVal⦈) = P'"
by (simp add: cat_Set_cs_simps cat_cs_simps up')
show "f'⦇ArrVal⦈ = cat_Set_obj_prod_up I F P' (app (π'⦇NTMap⦈))⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems': "a ∈⇩∘ P'"
from prems(1) prems' have "f'⦇ArrVal⦈⦇a⦈ ∈⇩∘ (∏⇩∘i∈⇩∘I. F i)"
by (cs_concl cs_intro: cat_Set_cs_intros)
note f'a = vproductD[OF this]
from prems' have dom_rhs:
"𝒟⇩∘ (cat_Set_obj_prod_up I F P' (app (π'⦇NTMap⦈))⦇ArrVal⦈⦇a⦈) = I"
by (cs_concl cs_simp: cat_Set_cs_simps)
show "f'⦇ArrVal⦈⦇a⦈ =
cat_Set_obj_prod_up I F P' (app (π'⦇NTMap⦈))⦇ArrVal⦈⦇a⦈"
proof(rule vsv_eqI, unfold f'a dom_rhs)
fix i assume "i ∈⇩∘ I"
with prems' show "f'⦇ArrVal⦈⦇a⦈⦇i⦈ =
cat_Set_obj_prod_up I F P' (app (π'⦇NTMap⦈))⦇ArrVal⦈⦇a⦈⦇i⦈"
by (cs_concl cs_simp: cat_Set_cs_simps)
qed (simp_all add: prems' f'a(1) cat_Set_obj_prod_up_ArrVal_app)
qed auto
qed (simp_all add: cat_Set_obj_prod_up_components f' up'(1))
qed
qed
subsection‹Equalizer for the category ‹Set››
subsubsection‹Definition and elementary properties›
abbreviation ntcf_Set_equalizer_map :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "ntcf_Set_equalizer_map α a g f i ≡
(
i = 𝔞⇩P⇩L ?
incl_Set (vequalizer a g f) a :
g ∘⇩A⇘cat_Set α⇙ incl_Set (vequalizer a g f) a
)"
definition ntcf_Set_equalizer :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "ntcf_Set_equalizer α a b g f = ntcf_equalizer_base
(cat_Set α) a b g f (vequalizer a g f) (ntcf_Set_equalizer_map α a g f)"
text‹Components.›
context
fixes a g f α :: V
begin
lemmas ntcf_Set_equalizer_components =
ntcf_equalizer_base_components[
where ℭ=‹cat_Set α›
and e=‹ntcf_Set_equalizer_map α a g f›
and E=‹vequalizer a g f›
and 𝔞=a and 𝔤=g and 𝔣=f,
folded ntcf_Set_equalizer_def
]
end
subsubsection‹Natural transformation map›
mk_VLambda ntcf_Set_equalizer_components(1)
|vsv ntcf_Set_equalizer_NTMap_vsv[cat_Set_cs_intros]|
|vdomain ntcf_Set_equalizer_NTMap_vdomain[cat_Set_cs_simps]|
|app ntcf_Set_equalizer_NTMap_app|
lemma ntcf_Set_equalizer_2_NTMap_app_𝔞[cat_Set_cs_simps]:
assumes "x = 𝔞⇩P⇩L"
shows
"ntcf_Set_equalizer α a b g f⦇NTMap⦈⦇x⦈ =
incl_Set (vequalizer a g f) a"
unfolding assms the_cat_parallel_components(1) ntcf_Set_equalizer_components
by simp
lemma ntcf_Set_equalizer_2_NTMap_app_𝔟[cat_Set_cs_simps]:
assumes "x = 𝔟⇩P⇩L"
shows
"ntcf_Set_equalizer α a b g f⦇NTMap⦈⦇x⦈ =
g ∘⇩A⇘cat_Set α⇙ incl_Set (vequalizer a g f) a"
unfolding assms the_cat_parallel_components(1) ntcf_Set_equalizer_components
using cat_PL_ineq
by auto
subsubsection‹Equalizer for the category ‹Set› is an equalizer›
lemma (in 𝒵) ntcf_Set_equalizer_2_is_cat_equalizer_2:
assumes "𝔤 : 𝔞 ↦⇘cat_Set α⇙ 𝔟" and "𝔣 : 𝔞 ↦⇘cat_Set α⇙ 𝔟"
shows "ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 :
vequalizer 𝔞 𝔤 𝔣 <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ cat_Set α"
proof(intro is_cat_equalizerI is_cat_equalizerI is_cat_limitI')
let ?II_II = ‹↑↑→↑↑ (cat_Set α) 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L 𝔞 𝔟 𝔤 𝔣›
and ?II = ‹↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L›
note 𝔤 = cat_Set_is_arrD[OF assms(1)]
interpret 𝔤: arr_Set α 𝔤
rewrites "𝔤⦇ArrDom⦈ = 𝔞" and "𝔤⦇ArrCod⦈ = 𝔟"
by (rule 𝔤(1)) (simp_all add: 𝔤)
note 𝔣 = cat_Set_is_arrD[OF assms(2)]
interpret 𝔣: arr_Set α 𝔣
rewrites "𝔣⦇ArrDom⦈ = 𝔞" and "𝔣⦇ArrCod⦈ = 𝔟"
by (rule 𝔣(1)) (simp_all add: 𝔣)
note [cat_Set_cs_intros] = 𝔤.arr_Set_ArrDom_in_Vset 𝔣.arr_Set_ArrCod_in_Vset
let ?incl = ‹incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞›
show 𝔞𝔟𝔤𝔣_is_cat_cone: "ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 :
vequalizer 𝔞 𝔤 𝔣 <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ?II_II : ?II ↦↦⇩C⇘α⇙ cat_Set α"
unfolding ntcf_Set_equalizer_def
proof
(
intro
category.cat_ntcf_equalizer_base_is_cat_cone
category.cat_cf_parallel_cat_equalizer
)
from assms show
"(𝔟⇩P⇩L = 𝔞⇩P⇩L ? ?incl : 𝔤 ∘⇩A⇘cat_Set α⇙ ?incl) :
vequalizer 𝔞 𝔤 𝔣 ↦⇘cat_Set α⇙ 𝔟"
by
(
cs_concl
cs_simp: V_cs_simps
cs_intro:
V_cs_intros cat_Set_cs_intros cat_cs_intros
cat_PL_ineq[symmetric]
)
show
"(𝔟⇩P⇩L = 𝔞⇩P⇩L ? ?incl : 𝔤 ∘⇩A⇘cat_Set α⇙ ?incl) =
𝔤 ∘⇩A⇘cat_Set α⇙ (𝔞⇩P⇩L = 𝔞⇩P⇩L ? ?incl : 𝔤 ∘⇩A⇘cat_Set α⇙ ?incl)"
by
(
cs_concl
cs_simp: V_cs_simps
cs_intro:
V_cs_intros cat_Set_cs_intros cat_cs_intros
cat_PL_ineq[symmetric]
)
from assms show
"(𝔟⇩P⇩L = 𝔞⇩P⇩L ? ?incl : 𝔤 ∘⇩A⇘cat_Set α⇙ ?incl) =
𝔣 ∘⇩A⇘cat_Set α⇙ (𝔞⇩P⇩L = 𝔞⇩P⇩L ? ?incl : 𝔤 ∘⇩A⇘cat_Set α⇙ ?incl)"
by
(
cs_concl
cs_simp: V_cs_simps cat_Set_incl_Set_commute
cs_intro: V_cs_intros cat_PL_ineq[symmetric]
)
qed
(
cs_concl
cs_intro: cat_cs_intros V_cs_intros cat_Set_cs_intros assms
cs_simp: V_cs_simps cat_cs_simps
)+
interpret 𝔞𝔟𝔤𝔣: is_cat_cone
α ‹vequalizer 𝔞 𝔤 𝔣› ?II ‹cat_Set α› ?II_II ‹ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣›
by (rule 𝔞𝔟𝔤𝔣_is_cat_cone)
show "∃!f'.
f' : r' ↦⇘cat_Set α⇙ vequalizer 𝔞 𝔤 𝔣 ∧
u' = ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙⇩N⇩T⇩C⇩F ntcf_const ?II (cat_Set α) f'"
if "u' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ?II_II : ?II ↦↦⇩C⇘α⇙ cat_Set α" for u' r'
proof-
interpret u': is_cat_cone α r' ?II ‹cat_Set α› ?II_II u' by (rule that(1))
have "𝔞⇩P⇩L ∈⇩∘ ↑↑⇩C 𝔞⇩P⇩L 𝔟⇩P⇩L 𝔤⇩P⇩L 𝔣⇩P⇩L⦇Obj⦈"
unfolding the_cat_parallel_components(1) by simp
from
u'.ntcf_NTMap_is_arr[OF this]
𝔞𝔟𝔤𝔣.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms]
have u'_𝔞⇩P⇩L_is_arr: "u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ : r' ↦⇘cat_Set α⇙ 𝔞"
by (cs_prems_atom_step cat_cs_simps)
(
cs_prems
cs_simp: cat_parallel_cs_simps
cs_intro:
cat_parallel_cs_intros
cat_cs_intros
category.cat_cf_parallel_cat_equalizer
)
note u'_𝔞⇩P⇩L = cat_Set_is_arrD[OF u'_𝔞⇩P⇩L_is_arr]
interpret u'_𝔞⇩P⇩L: arr_Set α ‹u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈› by (rule u'_𝔞⇩P⇩L(1))
have "𝔟⇩P⇩L ∈⇩∘ ?II⦇Obj⦈"
by (cs_concl cs_intro: cat_parallel_cs_intros)
from
u'.ntcf_NTMap_is_arr[OF this]
𝔞𝔟𝔤𝔣.NTDom.HomCod.cat_cf_parallel_cat_equalizer[OF assms]
have "u'⦇NTMap⦈⦇𝔟⇩P⇩L⦈ : r' ↦⇘cat_Set α⇙ 𝔟"
by
(
cs_prems
cs_simp: cat_cs_simps cat_parallel_cs_simps
cs_intro: cat_parallel_cs_intros
)
note u'_𝔤u' = cat_cone_cf_par_eps_NTMap_app(1)[OF that(1) assms]
define q where "q = [u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈⦇ArrVal⦈, r', vequalizer 𝔞 𝔤 𝔣]⇩∘"
have q_components[cat_Set_cs_simps]:
"q⦇ArrVal⦈ = u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈⦇ArrVal⦈"
"q⦇ArrDom⦈ = r'"
"q⦇ArrCod⦈ = vequalizer 𝔞 𝔤 𝔣"
unfolding q_def arr_field_simps by (simp_all add: nat_omega_simps)
from cat_cone_cf_par_eps_NTMap_app[OF that(1) assms] have 𝔤u'_eq_𝔣u':
"(𝔤 ∘⇩A⇘cat_Set α⇙ u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈)⦇ArrVal⦈⦇x⦈ =
(𝔣 ∘⇩A⇘cat_Set α⇙ u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈)⦇ArrVal⦈⦇x⦈"
for x
by simp
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
have u'_NTMap_vrange: "ℛ⇩∘ (u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈⦇ArrVal⦈) ⊆⇩∘ vequalizer 𝔞 𝔤 𝔣"
proof(rule vsubsetI)
fix y assume prems: "y ∈⇩∘ ℛ⇩∘ (u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈⦇ArrVal⦈)"
then obtain x where x: "x ∈⇩∘ 𝒟⇩∘ (u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈⦇ArrVal⦈)"
and y_def: "y = u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈⦇ArrVal⦈⦇x⦈"
by (blast dest: u'_𝔞⇩P⇩L.ArrVal.vrange_atD)
have x: "x ∈⇩∘ r'"
by (use x u'_𝔞⇩P⇩L_is_arr in ‹cs_prems cs_simp: cat_cs_simps›)
from 𝔤u'_eq_𝔣u'[of x] assms x u'_𝔞⇩P⇩L_is_arr have [simp]:
"𝔤⦇ArrVal⦈⦇u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈⦇ArrVal⦈⦇x⦈⦈ =
𝔣⦇ArrVal⦈⦇u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈⦇ArrVal⦈⦇x⦈⦈"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from prems u'_𝔞⇩P⇩L.arr_Set_ArrVal_vrange[unfolded u'_𝔞⇩P⇩L] show
"y ∈⇩∘ vequalizer 𝔞 𝔤 𝔣"
by (intro vequalizerI, unfold y_def) auto
qed
show q_is_arr: "q : r' ↦⇘cat_Set α⇙ vequalizer 𝔞 𝔤 𝔣"
proof(intro cat_Set_is_arrI arr_SetI)
show "q⦇ArrCod⦈ ∈⇩∘ Vset α"
by (auto simp: q_components intro: cat_cs_intros cat_lim_cs_intros)
qed
(
auto
simp:
cat_Set_cs_simps nat_omega_simps
u'_𝔞⇩P⇩L
q_def
u'_NTMap_vrange
𝔞𝔟𝔤𝔣.NTDom.HomCod.cat_in_Obj_in_Vset
intro: cat_cs_intros cat_lim_cs_intros
)
from q_is_arr have 𝔞_q:
"incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘⇩A⇘cat_Set α⇙ q :
r' ↦⇘cat_Set α⇙ 𝔞"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
)
interpret arr_Set α ‹incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘⇩A⇘cat_Set α⇙ q›
using 𝔞_q by (auto dest: cat_Set_is_arrD)
show "u' = ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙⇩N⇩T⇩C⇩F ntcf_const ?II (cat_Set α) q"
proof(rule ntcf_eqI)
from q_is_arr show
"ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙⇩N⇩T⇩C⇩F ntcf_const ?II (cat_Set α) q :
cf_const ?II (cat_Set α) r' ↦⇩C⇩F
?II_II : ?II ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have dom_lhs: "𝒟⇩∘ (u'⦇NTMap⦈) = ?II⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
from q_is_arr have dom_rhs:
"𝒟⇩∘
(
(ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙⇩N⇩T⇩C⇩F
ntcf_const ?II (cat_Set α) q
)⦇NTMap⦈) = ?II⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "u'⦇NTMap⦈ =
(
ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙⇩N⇩T⇩C⇩F ntcf_const ?II (cat_Set α) q
)⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
show "vsv ((
ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙⇩N⇩T⇩C⇩F ntcf_const ?II (cat_Set α) q
)⦇NTMap⦈)"
by (cs_concl cs_intro: cat_cs_intros)
fix a assume prems: "a ∈⇩∘ ?II⦇Obj⦈"
have [symmetric, cat_Set_cs_simps]:
"u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘⇩A⇘cat_Set α⇙ q"
proof(rule arr_Set_eqI[of α])
from u'_𝔞⇩P⇩L_is_arr have dom_lhs: "𝒟⇩∘ (u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈⦇ArrVal⦈) = r'"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from 𝔞_q have dom_rhs:
"𝒟⇩∘ ((incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘⇩A⇘cat_Set α⇙ q)⦇ArrVal⦈) = r'"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈⦇ArrVal⦈ =
(incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘⇩A⇘cat_Set α⇙ q)⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ∈⇩∘ r'"
with u'_NTMap_vrange dom_lhs u'_𝔞⇩P⇩L.ArrVal.vsv_vimageI2 have
"u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈⦇ArrVal⦈⦇a⦈ ∈⇩∘ vequalizer 𝔞 𝔤 𝔣"
by blast
with prems q_is_arr u'_𝔞⇩P⇩L_is_arr show
"u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈⦇ArrVal⦈⦇a⦈ =
(incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘⇩A⇘cat_Set α⇙ q)⦇ArrVal⦈⦇a⦈"
by
(
cs_concl
cs_simp: cat_Set_cs_simps cat_cs_simps
cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
)
qed auto
qed
(
use u'_𝔞⇩P⇩L 𝔞_q in ‹
cs_concl cs_intro: cat_Set_is_arrD(1) cs_simp: cat_cs_simps
›
)+
from q_is_arr have u'_NTMap_app_I: "u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ =
(
ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙⇩N⇩T⇩C⇩F ntcf_const ?II (cat_Set α) q
)⦇NTMap⦈⦇𝔞⇩P⇩L⦈"
by
(
cs_concl
cs_intro: cat_cs_intros cat_parallel_cs_intros
cs_simp: cat_Set_cs_simps cat_cs_simps V_cs_simps
)
from q_is_arr assms have u'_NTMap_app_sI: "u'⦇NTMap⦈⦇𝔟⇩P⇩L⦈ =
(
ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙⇩N⇩T⇩C⇩F ntcf_const ?II (cat_Set α) q
)⦇NTMap⦈⦇𝔟⇩P⇩L⦈"
by
(
cs_concl
cs_simp: cat_Set_cs_simps cat_cs_simps u'_𝔤u'
cs_intro:
V_cs_intros
cat_cs_intros
cat_Set_cs_intros
cat_parallel_cs_intros
)
from prems consider ‹a = 𝔞⇩P⇩L› | ‹a = 𝔟⇩P⇩L›
by (elim the_cat_parallel_ObjE)
then show
"u'⦇NTMap⦈⦇a⦈ =
(
ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙⇩N⇩T⇩C⇩F
ntcf_const ?II (cat_Set α) q
)⦇NTMap⦈⦇a⦈"
by cases (simp_all add: u'_NTMap_app_I u'_NTMap_app_sI)
qed auto
qed (simp_all add: u'.is_ntcf_axioms)
fix f' assume prems:
"f' : r' ↦⇘cat_Set α⇙ vequalizer 𝔞 𝔤 𝔣"
"u' = ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙⇩N⇩T⇩C⇩F ntcf_const ?II (cat_Set α) f'"
from prems(2) have u'_NTMap_app:
"u'⦇NTMap⦈⦇x⦈ =
(ntcf_Set_equalizer α 𝔞 𝔟 𝔤 𝔣 ∙⇩N⇩T⇩C⇩F
ntcf_const ?II (cat_Set α) f')⦇NTMap⦈⦇x⦈"
for x
by simp
have u'_f':
"u'⦇NTMap⦈⦇𝔞⇩P⇩L⦈ = incl_Set (vequalizer 𝔞 𝔤 𝔣) 𝔞 ∘⇩A⇘cat_Set α⇙ f'"
using u'_NTMap_app[of 𝔞⇩P⇩L] prems(1)
by
(
cs_prems
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_parallel_cs_intros
)
(cs_prems cs_simp: cat_Set_cs_simps cs_intro: cat_parallel_cs_intros)
note f' = cat_Set_is_arrD[OF prems(1)]
note q = cat_Set_is_arrD[OF q_is_arr]
interpret f': arr_Set α f' using prems(1) by (auto dest: cat_Set_is_arrD)
interpret q: arr_Set α q using q by (auto dest: cat_Set_is_arrD)
show "f' = q"
proof(rule arr_Set_eqI[of α])
have dom_lhs: "𝒟⇩∘ (f'⦇ArrVal⦈) = r'" by (simp add: cat_Set_cs_simps f')
from q_is_arr have dom_rhs: "𝒟⇩∘ (q⦇ArrVal⦈) = r'"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros)
show "f'⦇ArrVal⦈ = q⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix i assume "i ∈⇩∘ r'"
with prems(1) show "f'⦇ArrVal⦈⦇i⦈ = q⦇ArrVal⦈⦇i⦈"
by
(
cs_concl
cs_simp: cat_Set_cs_simps cat_cs_simps q_components u'_f'
cs_intro: V_cs_intros cat_cs_intros cat_Set_cs_intros
)
qed auto
qed
(
use prems(1) q_is_arr in ‹
cs_concl cs_simp: cat_cs_simps cs_intro: q cat_Set_is_arrD
›
)+
qed
qed
qed (auto intro: assms)
subsection‹The category ‹Set› is small-complete›
lemma (in 𝒵) cat_small_complete_cat_Set: "cat_small_complete α (cat_Set α)"
proof(rule category.cat_small_complete_if_eq_and_obj_prod)
show "∃E ε. ε : E <⇩C⇩F⇩.⇩e⇩q (𝔞,𝔟,𝔤,𝔣) : ↑↑⇧2⇩C ↦↦⇩C⇘α⇙ cat_Set α"
if "𝔣 : 𝔞 ↦⇘cat_Set α⇙ 𝔟" and "𝔤 : 𝔞 ↦⇘cat_Set α⇙ 𝔟" for 𝔞 𝔟 𝔤 𝔣
using ntcf_Set_equalizer_2_is_cat_equalizer_2[OF that(2,1)] by auto
show "∃P π. π : P <⇩C⇩F⇩.⇩∏ A : I ↦↦⇩C⇘α⇙ cat_Set α"
if "tm_cf_discrete α I A (cat_Set α)" for A I
proof(intro exI, rule tm_cf_discrete_ntcf_obj_prod_base_is_cat_obj_prod)
interpret tm_cf_discrete α I A ‹cat_Set α› by (rule that)
show "VLambda I A ∈⇩∘ Vset α" by (rule tm_cf_discrete_ObjMap_in_Vset)
qed
qed (rule category_cat_Set)
text‹\newpage›
end
Theory CZH_UCAT_Adjoints
section‹Adjoints›
theory CZH_UCAT_Adjoints
imports
CZH_UCAT_Universal
CZH_Elementary_Categories.CZH_ECAT_Yoneda
begin
subsection‹Background›
named_theorems adj_cs_simps
named_theorems adj_cs_intros
named_theorems adj_field_simps
definition AdjLeft :: V where [adj_field_simps]: "AdjLeft = 0"
definition AdjRight :: V where [adj_field_simps]: "AdjRight = 1⇩ℕ"
definition AdjNT :: V where [adj_field_simps]: "AdjNT = 2⇩ℕ"
subsection‹Definition and elementary properties›
text‹
See subsection 2.1 in \cite{bodo_categories_1970} or Chapter IV-1 in
\cite{mac_lane_categories_2010}.
›
locale is_cf_adjunction =
𝒵 α +
vfsequence Φ +
L: category α ℭ +
R: category α 𝔇 +
LR: is_functor α ℭ 𝔇 𝔉 +
RL: is_functor α 𝔇 ℭ 𝔊 +
NT: is_iso_ntcf
α
‹op_cat ℭ ×⇩C 𝔇›
‹cat_Set α›
‹Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉-,-)›
‹Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-)›
‹Φ⦇AdjNT⦈›
for α ℭ 𝔇 𝔉 𝔊 Φ +
assumes cf_adj_length[adj_cs_simps]: "vcard Φ = 3⇩ℕ"
and cf_adj_AdjLeft[adj_cs_simps]: "Φ⦇AdjLeft⦈ = 𝔉"
and cf_adj_AdjRight[adj_cs_simps]: "Φ⦇AdjRight⦈ = 𝔊"
syntax "_is_cf_adjunction" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ : _ ⇌⇩C⇩F _ : _ ⇌⇌⇩Cı _)› [51, 51, 51, 51, 51] 51)
translations "Φ : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇" ⇌
"CONST is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ"
lemmas [adj_cs_simps] =
is_cf_adjunction.cf_adj_length
is_cf_adjunction.cf_adj_AdjLeft
is_cf_adjunction.cf_adj_AdjRight
text‹Components.›
lemma cf_adjunction_components[adj_cs_simps]:
"[𝔉, 𝔊, φ]⇩∘⦇AdjLeft⦈ = 𝔉"
"[𝔉, 𝔊, φ]⇩∘⦇AdjRight⦈ = 𝔊"
"[𝔉, 𝔊, φ]⇩∘⦇AdjNT⦈ = φ"
unfolding AdjLeft_def AdjRight_def AdjNT_def
by (simp_all add: nat_omega_simps)
text‹Rules.›
lemma (in is_cf_adjunction) is_cf_adjunction_axioms'[adj_cs_intros]:
assumes "α' = α" and "ℭ' = ℭ" and "𝔇' = 𝔇" and "𝔉' = 𝔉" and "𝔊' = 𝔊"
shows "Φ : 𝔉' ⇌⇩C⇩F 𝔊' : ℭ' ⇌⇌⇩C⇘α'⇙ 𝔇'"
unfolding assms by (rule is_cf_adjunction_axioms)
lemmas (in is_cf_adjunction) [adj_cs_intros] = is_cf_adjunction_axioms
mk_ide rf is_cf_adjunction_def[unfolded is_cf_adjunction_axioms_def]
|intro is_cf_adjunctionI|
|dest is_cf_adjunctionD[dest]|
|elim is_cf_adjunctionE[elim]|
lemmas [adj_cs_intros] = is_cf_adjunctionD(3-6)
lemma (in is_cf_adjunction) cf_adj_is_iso_ntcf':
assumes "𝔉' = Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉-,-)"
and "𝔊' = Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-)"
and "𝔄' = op_cat ℭ ×⇩C 𝔇"
and "𝔅' = cat_Set α"
shows "Φ⦇AdjNT⦈ : 𝔉' ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔊' : 𝔄' ↦↦⇩C⇘α⇙ 𝔅'"
unfolding assms by (auto intro: cat_cs_intros)
lemmas [adj_cs_intros] = is_cf_adjunction.cf_adj_is_iso_ntcf'
lemma cf_adj_eqI:
assumes "Φ : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "Φ' : 𝔉' ⇌⇩C⇩F 𝔊' : ℭ' ⇌⇌⇩C⇘α⇙ 𝔇'"
and "ℭ = ℭ'"
and "𝔇 = 𝔇'"
and "𝔉 = 𝔉'"
and "𝔊 = 𝔊'"
and "Φ⦇AdjNT⦈ = Φ'⦇AdjNT⦈"
shows "Φ = Φ'"
proof-
interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
interpret Φ': is_cf_adjunction α ℭ' 𝔇' 𝔉' 𝔊' Φ' by (rule assms(2))
show ?thesis
proof(rule vsv_eqI)
have dom: "𝒟⇩∘ Φ = 3⇩ℕ" by (cs_concl cs_simp: V_cs_simps adj_cs_simps)
show "𝒟⇩∘ Φ = 𝒟⇩∘ Φ'" by (cs_concl cs_simp: V_cs_simps adj_cs_simps dom)
from assms(4-7) have sup:
"Φ⦇AdjLeft⦈ = Φ'⦇AdjLeft⦈"
"Φ⦇AdjRight⦈ = Φ'⦇AdjRight⦈"
"Φ⦇AdjNT⦈ = Φ'⦇AdjNT⦈"
by (simp_all add: adj_cs_simps)
show "a ∈⇩∘ 𝒟⇩∘ Φ ⟹ Φ⦇a⦈ = Φ'⦇a⦈" for a
by (unfold dom, elim_in_numeral, insert sup)
(auto simp: adj_field_simps)
qed (auto simp: Φ.L.vsv_axioms Φ'.vsv_axioms)
qed
subsection‹Opposite adjunction›
subsubsection‹Definition and elementary properties›
text‹
The following definition has the desired properties of the operation
of taking an opposite of an adjunction but helps to avoid dealing
with isomorphisms that arise in certain applications if the conventional
operation of taking the opposite is used instead.
›
abbreviation op_cf_adj_nt :: "V ⇒ V ⇒ V ⇒ V"
where "op_cf_adj_nt ℭ 𝔇 φ ≡ inv_ntcf (bnt_flip (op_cat ℭ) 𝔇 φ)"
definition op_cf_adj :: "V ⇒ V"
where "op_cf_adj Φ =
[
op_cf (Φ⦇AdjRight⦈),
op_cf (Φ⦇AdjLeft⦈),
op_cf_adj_nt (Φ⦇AdjLeft⦈⦇HomDom⦈) (Φ⦇AdjLeft⦈⦇HomCod⦈) (Φ⦇AdjNT⦈)
]⇩∘"
lemma op_cf_adj_components:
shows "op_cf_adj Φ⦇AdjLeft⦈ = op_cf (Φ⦇AdjRight⦈)"
and "op_cf_adj Φ⦇AdjRight⦈ = op_cf (Φ⦇AdjLeft⦈)"
and "op_cf_adj Φ⦇AdjNT⦈ =
op_cf_adj_nt (Φ⦇AdjLeft⦈⦇HomDom⦈) (Φ⦇AdjLeft⦈⦇HomCod⦈) (Φ⦇AdjNT⦈)"
unfolding op_cf_adj_def adj_field_simps by (simp_all add: nat_omega_simps)
lemma (in is_cf_adjunction) op_cf_adj_components:
shows "op_cf_adj Φ⦇AdjLeft⦈ = op_cf 𝔊"
and "op_cf_adj Φ⦇AdjRight⦈ = op_cf 𝔉"
and "op_cf_adj Φ⦇AdjNT⦈ = inv_ntcf (bnt_flip (op_cat ℭ) 𝔇 (Φ⦇AdjNT⦈))"
unfolding op_cf_adj_components by (simp_all add: cat_cs_simps adj_cs_simps)
lemmas [cat_op_simps] = is_cf_adjunction.op_cf_adj_components
text‹The opposite adjunction is an adjunction.›
lemma (in is_cf_adjunction) is_cf_adjunction_op:
"op_cf_adj Φ : op_cf 𝔊 ⇌⇩C⇩F op_cf 𝔉 : op_cat 𝔇 ⇌⇌⇩C⇘α⇙ op_cat ℭ"
proof(intro is_cf_adjunctionI, unfold cat_op_simps, unfold op_cf_adj_components)
show "vfsequence (op_cf_adj Φ)" unfolding op_cf_adj_def by simp
show "vcard (op_cf_adj Φ) = 3⇩ℕ"
unfolding op_cf_adj_def by (simp add: nat_omega_simps)
note adj = is_cf_adjunctionD[OF is_cf_adjunction_axioms]
from adj have f_φ: "bnt_flip (op_cat ℭ) 𝔇 (Φ⦇AdjNT⦈) :
Hom⇩O⇩.⇩C⇘α⇙op_cat 𝔇(-,op_cf 𝔉-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙op_cat ℭ(op_cf 𝔊-,-) :
𝔇 ×⇩C op_cat ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)
show "op_cf_adj_nt ℭ 𝔇 (Φ⦇AdjNT⦈) :
Hom⇩O⇩.⇩C⇘α⇙op_cat ℭ(op_cf 𝔊-,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙op_cat 𝔇(-,op_cf 𝔉-) :
𝔇 ×⇩C op_cat ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (rule CZH_ECAT_NTCF.iso_ntcf_is_arr_isomorphism(1)[OF f_φ])
qed (auto intro: cat_cs_intros cat_op_intros)
lemmas is_cf_adjunction_op =
is_cf_adjunction.is_cf_adjunction_op
lemma (in is_cf_adjunction) is_cf_adjunction_op'[cat_op_intros]:
assumes "𝔊' = op_cf 𝔊"
and "𝔉' = op_cf 𝔉"
and "𝔇' = op_cat 𝔇"
and "ℭ' = op_cat ℭ"
shows "op_cf_adj Φ : 𝔊' ⇌⇩C⇩F 𝔉' : 𝔇' ⇌⇌⇩C⇘α⇙ ℭ'"
unfolding assms by (rule is_cf_adjunction_op)
lemmas [cat_op_intros] = is_cf_adjunction.is_cf_adjunction_op'
text‹The operation of taking the opposite adjunction is an involution.›
lemma (in is_cf_adjunction) cf_adjunction_op_cf_adj_op_cf_adj[cat_op_simps]:
"op_cf_adj (op_cf_adj Φ) = Φ"
proof(rule cf_adj_eqI)
show Φ': "op_cf_adj (op_cf_adj Φ) : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
proof(intro is_cf_adjunctionI)
show "vfsequence (op_cf_adj (op_cf_adj Φ))" unfolding op_cf_adj_def by simp
from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj Φ)⦇AdjNT⦈ :
Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉-,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-) :
op_cat ℭ ×⇩C 𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
by
(
cs_concl cs_ist_simple
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros
cs_simp: cat_cs_simps cat_op_simps
)
show "vcard (op_cf_adj (op_cf_adj Φ)) = 3⇩ℕ"
unfolding op_cf_adj_def by (simp add: nat_omega_simps)
from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj Φ)⦇AdjLeft⦈ = 𝔉"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
from is_cf_adjunction_axioms show "op_cf_adj (op_cf_adj Φ)⦇AdjRight⦈ = 𝔊"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
qed (auto intro: cat_cs_intros)
interpret Φ': is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 ‹op_cf_adj (op_cf_adj Φ)›
by (rule Φ')
show "op_cf_adj (op_cf_adj Φ)⦇AdjNT⦈ = Φ⦇AdjNT⦈"
proof(rule ntcf_eqI)
show op_op_Φ:
"op_cf_adj (op_cf_adj Φ)⦇AdjNT⦈ :
Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉-,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-) :
op_cat ℭ ×⇩C 𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
by (rule Φ'.NT.is_ntcf_axioms)
show Φ: "Φ⦇AdjNT⦈ :
Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉-,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-) :
op_cat ℭ ×⇩C 𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
by (rule NT.is_ntcf_axioms)
from op_op_Φ have dom_lhs:
"𝒟⇩∘ (op_cf_adj (op_cf_adj Φ)⦇AdjNT⦈⦇NTMap⦈) = (op_cat ℭ ×⇩C 𝔇)⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
show "op_cf_adj (op_cf_adj Φ)⦇AdjNT⦈⦇NTMap⦈ = Φ⦇AdjNT⦈⦇NTMap⦈"
proof(rule vsv_eqI, unfold NT.ntcf_NTMap_vdomain dom_lhs)
fix cd assume prems: "cd ∈⇩∘ (op_cat ℭ ×⇩C 𝔇)⦇Obj⦈"
then obtain c d
where cd_def: "cd = [c, d]⇩∘"
and c: "c ∈⇩∘ op_cat ℭ⦇Obj⦈"
and d: "d ∈⇩∘ 𝔇⦇Obj⦈"
by (elim cat_prod_2_ObjE[OF L.category_op R.category_axioms prems])
from is_cf_adjunction_axioms c d L.category_axioms R.category_axioms Φ
show
"op_cf_adj (op_cf_adj Φ)⦇AdjNT⦈⦇NTMap⦈⦇cd⦈ = Φ⦇AdjNT⦈⦇NTMap⦈⦇cd⦈"
unfolding cd_def cat_op_simps
by
(
cs_concl
cs_intro:
cat_arrow_cs_intros
ntcf_cs_intros
adj_cs_intros
cat_op_intros
cat_cs_intros
cat_prod_cs_intros
cs_simp: cat_cs_simps cat_op_simps
)
qed (auto intro: inv_ntcf_NTMap_vsv)
qed simp_all
qed (auto intro: adj_cs_intros)
lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_op_cf_adj_op_cf_adj
subsubsection‹Alternative form of the naturality condition›
text‹
The lemmas in this subsection are based on the comments on page 81 in
\cite{mac_lane_categories_2010}.
›
lemma (in is_cf_adjunction) cf_adj_Comp_commute_RL:
assumes "x ∈⇩∘ ℭ⦇Obj⦈"
and "f : 𝔉⦇ObjMap⦈⦇x⦈ ↦⇘𝔇⇙ a"
and "k : a ↦⇘𝔇⇙ a'"
shows
"𝔊⦇ArrMap⦈⦇k⦈ ∘⇩A⇘ℭ⇙ (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙)⦇ArrVal⦈⦇f⦈ =
(Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a'⦈⇩∙)⦇ArrVal⦈⦇k ∘⇩A⇘𝔇⇙ f⦈"
proof-
from
assms
is_cf_adjunction_axioms
L.category_axioms R.category_axioms
L.category_op R.category_op
have φ_x_a: "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙ :
Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a ↦⇘cat_Set α⇙ Hom ℭ x (𝔊⦇ObjMap⦈⦇a⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
note φ_x_a_f =
cat_Set_ArrVal_app_vrange[OF φ_x_a, unfolded in_Hom_iff, OF assms(2)]
from
is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have φ_x_a':
"Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a'⦈⇩∙ :
Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a' ↦⇘cat_Set α⇙ Hom ℭ x (𝔊⦇ObjMap⦈⦇a'⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
from is_cf_adjunction_axioms this assms have x_k:
"[ℭ⦇CId⦈⦇x⦈, k]⇩∘ : [x, a]⇩∘ ↦⇘op_cat ℭ ×⇩C 𝔇⇙ [x, a']⇩∘"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
from
NT.ntcf_Comp_commute[OF this] is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have
"Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a'⦈⇩∙ ∘⇩A⇘cat_Set α⇙ cf_hom 𝔇 [𝔇⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈, k]⇩∘ =
cf_hom ℭ [ℭ⦇CId⦈⦇x⦈, 𝔊⦇ArrMap⦈⦇k⦈]⇩∘ ∘⇩A⇘cat_Set α⇙ Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙"
(is ‹?lhs = ?rhs›)
by
(
cs_prems cs_ist_simple
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
moreover from
is_cf_adjunction_axioms assms φ_x_a'
L.category_axioms R.category_axioms
L.category_op R.category_op
have
"?lhs⦇ArrVal⦈⦇f⦈ = (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a'⦈⇩∙)⦇ArrVal⦈⦇k ∘⇩A⇘𝔇⇙ f⦈"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
moreover from
is_cf_adjunction_axioms assms φ_x_a_f
L.category_axioms R.category_axioms
L.category_op R.category_op
have
"?rhs⦇ArrVal⦈⦇f⦈ = 𝔊⦇ArrMap⦈⦇k⦈ ∘⇩A⇘ℭ⇙ (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙)⦇ArrVal⦈⦇f⦈"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
ultimately show ?thesis by simp
qed
lemma (in is_cf_adjunction) cf_adj_Comp_commute_LR:
assumes "x ∈⇩∘ ℭ⦇Obj⦈"
and "f : 𝔉⦇ObjMap⦈⦇x⦈ ↦⇘𝔇⇙ a"
and "h : x' ↦⇘ℭ⇙ x"
shows
"(Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙)⦇ArrVal⦈⦇f⦈ ∘⇩A⇘ℭ⇙ h =
(Φ⦇AdjNT⦈⦇NTMap⦈⦇x', a⦈⇩∙)⦇ArrVal⦈⦇f ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇h⦈⦈"
proof-
from
is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have φ_x_a: "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙ :
Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a ↦⇘cat_Set α⇙ Hom ℭ x (𝔊⦇ObjMap⦈⦇a⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
note φ_x_a_f =
cat_Set_ArrVal_app_vrange[OF φ_x_a, unfolded in_Hom_iff, OF assms(2)]
from is_cf_adjunction_axioms assms have
"[h, 𝔇⦇CId⦈⦇a⦈]⇩∘ : [x, a]⇩∘ ↦⇘op_cat ℭ ×⇩C 𝔇⇙ [x', a]⇩∘"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
from
NT.ntcf_Comp_commute[OF this] is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have
"Φ⦇AdjNT⦈⦇NTMap⦈⦇x', a⦈⇩∙ ∘⇩A⇘cat_Set α⇙ cf_hom 𝔇 [𝔉⦇ArrMap⦈⦇h⦈, 𝔇⦇CId⦈⦇a⦈]⇩∘ =
cf_hom ℭ [h, ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇a⦈⦈]⇩∘ ∘⇩A⇘cat_Set α⇙ Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙"
(is ‹?lhs = ?rhs›)
by
(
cs_prems
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
moreover from
is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have
"?lhs⦇ArrVal⦈⦇f⦈ = (Φ⦇AdjNT⦈⦇NTMap⦈⦇x', a⦈⇩∙)⦇ArrVal⦈⦇f ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇h⦈⦈"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
moreover from
is_cf_adjunction_axioms assms φ_x_a_f
L.category_axioms R.category_axioms
L.category_op R.category_op
have
"?rhs⦇ArrVal⦈⦇f⦈ = (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙)⦇ArrVal⦈⦇f⦈ ∘⇩A⇘ℭ⇙ h"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
ultimately show ?thesis by simp
qed
subsection‹Unit›
subsubsection‹Definition and elementary properties›
text‹See Chapter IV-1 in \cite{mac_lane_categories_2010}.›
definition cf_adjunction_unit :: "V ⇒ V" (‹η⇩C›)
where "η⇩C Φ =
[
(
λx∈⇩∘Φ⦇AdjLeft⦈⦇HomDom⦈⦇Obj⦈.
(Φ⦇AdjNT⦈⦇NTMap⦈⦇x, Φ⦇AdjLeft⦈⦇ObjMap⦈⦇x⦈⦈⇩∙)⦇ArrVal⦈⦇
Φ⦇AdjLeft⦈⦇HomCod⦈⦇CId⦈⦇Φ⦇AdjLeft⦈⦇ObjMap⦈⦇x⦈⦈
⦈
),
cf_id (Φ⦇AdjLeft⦈⦇HomDom⦈),
(Φ⦇AdjRight⦈) ∘⇩C⇩F (Φ⦇AdjLeft⦈),
Φ⦇AdjLeft⦈⦇HomDom⦈,
Φ⦇AdjLeft⦈⦇HomDom⦈
]⇩∘"
text‹Components.›
lemma cf_adjunction_unit_components:
shows "η⇩C Φ⦇NTMap⦈ =
(
λx∈⇩∘Φ⦇AdjLeft⦈⦇HomDom⦈⦇Obj⦈.
(Φ⦇AdjNT⦈⦇NTMap⦈⦇x, Φ⦇AdjLeft⦈⦇ObjMap⦈⦇x⦈⦈⇩∙)⦇ArrVal⦈⦇
Φ⦇AdjLeft⦈⦇HomCod⦈⦇CId⦈⦇Φ⦇AdjLeft⦈⦇ObjMap⦈⦇x⦈⦈
⦈
)"
and "η⇩C Φ⦇NTDom⦈ = cf_id (Φ⦇AdjLeft⦈⦇HomDom⦈)"
and "η⇩C Φ⦇NTCod⦈ = (Φ⦇AdjRight⦈) ∘⇩C⇩F (Φ⦇AdjLeft⦈)"
and "η⇩C Φ⦇NTDGDom⦈ = Φ⦇AdjLeft⦈⦇HomDom⦈"
and "η⇩C Φ⦇NTDGCod⦈ = Φ⦇AdjLeft⦈⦇HomDom⦈"
unfolding cf_adjunction_unit_def nt_field_simps
by (simp_all add: nat_omega_simps)
context is_cf_adjunction
begin
lemma cf_adjunction_unit_components':
shows "η⇩C Φ⦇NTMap⦈ =
(
λx∈⇩∘ℭ⦇Obj⦈.
(Φ⦇AdjNT⦈⦇NTMap⦈⦇x, 𝔉⦇ObjMap⦈⦇x⦈⦈⇩∙)⦇ArrVal⦈⦇𝔇⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈⦈
)"
and "η⇩C Φ⦇NTDom⦈ = cf_id ℭ"
and "η⇩C Φ⦇NTCod⦈ = 𝔊 ∘⇩C⇩F 𝔉"
and "η⇩C Φ⦇NTDGDom⦈ = ℭ"
and "η⇩C Φ⦇NTDGCod⦈ = ℭ"
unfolding cf_adjunction_unit_components
by (cs_concl cs_simp: cat_cs_simps adj_cs_simps)+
mk_VLambda cf_adjunction_unit_components'(1)
|vdomain cf_adjunction_unit_NTMap_vdomain[adj_cs_simps]|
|app cf_adjunction_unit_NTMap_app[adj_cs_simps]|
end
mk_VLambda cf_adjunction_unit_components(1)
|vsv cf_adjunction_unit_NTMap_vsv[adj_cs_intros]|
lemmas [adj_cs_simps] =
is_cf_adjunction.cf_adjunction_unit_NTMap_vdomain
is_cf_adjunction.cf_adjunction_unit_NTMap_app
subsubsection‹Natural transformation map›
lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_is_arr:
assumes "x ∈⇩∘ ℭ⦇Obj⦈"
shows "η⇩C Φ⦇NTMap⦈⦇x⦈ : x ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
proof-
from
is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have φ_x_𝔉x:
"Φ⦇AdjNT⦈⦇NTMap⦈⦇x, 𝔉⦇ObjMap⦈⦇x⦈⦈⇩∙ :
Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) (𝔉⦇ObjMap⦈⦇x⦈) ↦⇘cat_Set α⇙
Hom ℭ x (𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
from is_cf_adjunction_axioms assms have CId_𝔉x:
"𝔇⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈ : 𝔉⦇ObjMap⦈⦇x⦈ ↦⇘𝔇⇙ 𝔉⦇ObjMap⦈⦇x⦈"
by (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)
from
is_cf_adjunction_axioms
assms
cat_Set_ArrVal_app_vrange[OF φ_x_𝔉x, unfolded in_Hom_iff, OF CId_𝔉x]
show "η⇩C Φ⦇NTMap⦈⦇x⦈ : x ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
qed
lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_is_arr':
assumes "x ∈⇩∘ ℭ⦇Obj⦈"
and "a = x"
and "b = 𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
and "ℭ' = ℭ"
shows "η⇩C Φ⦇NTMap⦈⦇x⦈ : x ↦⇘ℭ'⇙ b"
using assms(1) unfolding assms(2-4) by (rule cf_adjunction_unit_NTMap_is_arr)
lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_unit_NTMap_is_arr'
lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_vrange:
"ℛ⇩∘ (η⇩C Φ⦇NTMap⦈) ⊆⇩∘ ℭ⦇Arr⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cf_adjunction_unit_NTMap_vdomain)
fix x assume prems: "x ∈⇩∘ ℭ⦇Obj⦈"
from cf_adjunction_unit_NTMap_is_arr[OF prems] show "η⇩C Φ⦇NTMap⦈⦇x⦈ ∈⇩∘ ℭ⦇Arr⦈"
by auto
qed (auto intro: adj_cs_intros)
subsubsection‹Unit is a natural transformation›
lemma (in is_cf_adjunction) cf_adjunction_unit_is_ntcf:
"η⇩C Φ : cf_id ℭ ↦⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
proof(intro is_ntcfI')
show "vfsequence (η⇩C Φ)" unfolding cf_adjunction_unit_def by simp
show "vcard (η⇩C Φ) = 5⇩ℕ"
unfolding cf_adjunction_unit_def by (simp add: nat_omega_simps)
from is_cf_adjunction_axioms show "cf_id ℭ : ℭ ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
from is_cf_adjunction_axioms show "𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
from is_cf_adjunction_axioms show "𝒟⇩∘ (η⇩C Φ⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
show "η⇩C Φ⦇NTMap⦈⦇a⦈ : cf_id ℭ⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ (𝔊 ∘⇩C⇩F 𝔉)⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ ℭ⦇Obj⦈" for a
using is_cf_adjunction_axioms that
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
show
"η⇩C Φ⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ cf_id ℭ⦇ArrMap⦈⦇f⦈ =
(𝔊 ∘⇩C⇩F 𝔉)⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ η⇩C Φ⦇NTMap⦈⦇a⦈"
if "f : a ↦⇘ℭ⇙ b" for a b f
using is_cf_adjunction_axioms that
by
(
cs_concl
cs_simp:
cf_adj_Comp_commute_RL cf_adj_Comp_commute_LR
cat_cs_simps
adj_cs_simps
cs_intro: cat_cs_intros adj_cs_intros
)
qed (auto simp: cf_adjunction_unit_components')
lemma (in is_cf_adjunction) cf_adjunction_unit_is_ntcf':
assumes "𝔖 = cf_id ℭ"
and "𝔖' = 𝔊 ∘⇩C⇩F 𝔉"
and "𝔄 = ℭ"
and "𝔅 = ℭ"
shows "η⇩C Φ : 𝔖 ↦⇩C⇩F 𝔖' : 𝔄 ↦↦⇩C⇘α⇙ 𝔅"
unfolding assms by (rule cf_adjunction_unit_is_ntcf)
lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_unit_is_ntcf'
subsubsection‹Every component of a unit is a universal arrow›
text‹
The lemmas in this subsection are based on elements of the statement of
Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›
lemma (in is_cf_adjunction) cf_adj_umap_of_unit:
assumes "x ∈⇩∘ ℭ⦇Obj⦈" and "a ∈⇩∘ 𝔇⦇Obj⦈"
shows "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙ =
umap_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⇩C Φ⦇NTMap⦈⦇x⦈) a"
(is ‹Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙ = ?uof_a›)
proof-
from
is_cf_adjunction_axioms assms
L.category_axioms R.category_axioms
L.category_op R.category_op
have φ_xa: "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙ :
Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a ↦⇘cat_Set α⇙ Hom ℭ x (𝔊⦇ObjMap⦈⦇a⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
then have dom_lhs:
"𝒟⇩∘ ((Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙)⦇ArrVal⦈) = Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a"
by (cs_concl cs_simp: cat_cs_simps)
from is_cf_adjunction_axioms assms have uof_a:
"?uof_a : Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a ↦⇘cat_Set α⇙ Hom ℭ x (𝔊⦇ObjMap⦈⦇a⦈)"
by (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)
then have dom_rhs: "𝒟⇩∘ (?uof_a⦇ArrVal⦈) = Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI[of α])
from φ_xa show arr_Set_φ_xa: "arr_Set α (Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙)"
by (auto dest: cat_Set_is_arrD(1))
from uof_a show arr_Set_uof_a: "arr_Set α ?uof_a"
by (auto dest: cat_Set_is_arrD(1))
show "(Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙)⦇ArrVal⦈ = ?uof_a⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix g assume prems: "g : 𝔉⦇ObjMap⦈⦇x⦈ ↦⇘𝔇⇙ a"
from is_cf_adjunction_axioms assms prems show
"(Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙)⦇ArrVal⦈⦇g⦈ = ?uof_a⦇ArrVal⦈⦇g⦈"
by
(
cs_concl
cs_simp:
cf_adj_Comp_commute_RL
adj_cs_simps
cat_cs_simps
cat_op_simps
cat_prod_cs_simps
cs_intro:
adj_cs_intros
ntcf_cs_intros
cat_cs_intros
cat_op_intros
cat_prod_cs_intros
)
qed (use arr_Set_φ_xa arr_Set_uof_a in auto)
qed (use φ_xa uof_a in ‹cs_concl cs_simp: cat_cs_simps›)+
qed
lemma (in is_cf_adjunction) cf_adj_umap_of_unit':
assumes "x ∈⇩∘ ℭ⦇Obj⦈"
and "a ∈⇩∘ 𝔇⦇Obj⦈"
and "η = η⇩C Φ⦇NTMap⦈⦇x⦈"
and "𝔉x = 𝔉⦇ObjMap⦈⦇x⦈"
shows "Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙ = umap_of 𝔊 x 𝔉x η a"
using assms(1,2) unfolding assms(3,4) by (rule cf_adj_umap_of_unit)
lemma (in is_cf_adjunction) cf_adjunction_unit_component_is_ua_of:
assumes "x ∈⇩∘ ℭ⦇Obj⦈"
shows "universal_arrow_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⇩C Φ⦇NTMap⦈⦇x⦈)"
(is ‹universal_arrow_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) ?ηx›)
proof(rule RL.cf_ua_of_if_ntcf_ua_of_is_iso_ntcf)
from is_cf_adjunction_axioms assms show "𝔉⦇ObjMap⦈⦇x⦈ ∈⇩∘ 𝔇⦇Obj⦈"
by (cs_concl cs_intro: cat_cs_intros adj_cs_intros)
from is_cf_adjunction_axioms assms show
"η⇩C Φ⦇NTMap⦈⦇x⦈ : x ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
by (cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)
show
"ntcf_ua_of α 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⇩C Φ⦇NTMap⦈⦇x⦈) :
Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉⦇ObjMap⦈⦇x⦈,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(x,-) ∘⇩C⇩F 𝔊 :
𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
(is ‹?ntcf_ua_of : ?H𝔉 ↦⇩C⇩F⇩.⇩i⇩s⇩o ?H𝔊 : 𝔇 ↦↦⇩C⇘α⇙ cat_Set α›)
proof(rule is_iso_ntcfI)
from is_cf_adjunction_axioms assms show
"?ntcf_ua_of : ?H𝔉 ↦⇩C⇩F ?H𝔊 : 𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
by (intro RL.cf_ntcf_ua_of_is_ntcf)
(cs_concl cs_simp: cs_intro: cat_cs_intros adj_cs_intros)+
fix a assume prems: "a ∈⇩∘ 𝔇⦇Obj⦈"
from assms prems have
"Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙ = umap_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) ?ηx a"
(is ‹Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙ = ?uof_a›)
by (rule cf_adj_umap_of_unit)
from assms prems L.category_axioms R.category_axioms have
"[x, a]⇩∘ ∈⇩∘ (op_cat ℭ ×⇩C 𝔇)⦇Obj⦈"
by (cs_concl cs_simp: cs_intro: cat_op_intros cat_prod_cs_intros)
from
NT.iso_ntcf_is_arr_isomorphism[
OF this, unfolded cf_adj_umap_of_unit[OF assms prems]
]
is_cf_adjunction_axioms assms prems
L.category_axioms R.category_axioms
have "?uof_a :
Hom 𝔇 (𝔉⦇ObjMap⦈⦇x⦈) a ↦⇩i⇩s⇩o⇘cat_Set α⇙ Hom ℭ x (𝔊⦇ObjMap⦈⦇a⦈)"
by
(
cs_prems
cs_simp: cat_cs_simps
cs_intro:
cat_cs_intros cat_op_intros adj_cs_intros cat_prod_cs_intros
)
with is_cf_adjunction_axioms assms prems show
"?ntcf_ua_of⦇NTMap⦈⦇a⦈ : ?H𝔉⦇ObjMap⦈⦇a⦈ ↦⇩i⇩s⇩o⇘cat_Set α⇙ ?H𝔊⦇ObjMap⦈⦇a⦈"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros adj_cs_intros
)
qed
qed
subsection‹Counit›
subsubsection‹Definition and elementary properties›
definition cf_adjunction_counit :: "V ⇒ V" (‹ε⇩C›)
where "ε⇩C Φ =
[
(
λx∈⇩∘Φ⦇AdjLeft⦈⦇HomCod⦈⦇Obj⦈.
(Φ⦇AdjNT⦈⦇NTMap⦈⦇Φ⦇AdjRight⦈⦇ObjMap⦈⦇x⦈, x⦈⇩∙)¯⇩S⇩e⇩t⦇ArrVal⦈⦇
Φ⦇AdjLeft⦈⦇HomDom⦈⦇CId⦈⦇Φ⦇AdjRight⦈⦇ObjMap⦈⦇x⦈⦈
⦈
),
(Φ⦇AdjLeft⦈) ∘⇩C⇩F (Φ⦇AdjRight⦈),
cf_id (Φ⦇AdjLeft⦈⦇HomCod⦈),
Φ⦇AdjLeft⦈⦇HomCod⦈,
Φ⦇AdjLeft⦈⦇HomCod⦈
]⇩∘"
text‹Components.›
lemma cf_adjunction_counit_components:
shows "ε⇩C Φ⦇NTMap⦈ =
(
λx∈⇩∘Φ⦇AdjLeft⦈⦇HomCod⦈⦇Obj⦈.
(Φ⦇AdjNT⦈⦇NTMap⦈⦇Φ⦇AdjRight⦈⦇ObjMap⦈⦇x⦈, x⦈⇩∙)¯⇩S⇩e⇩t⦇ArrVal⦈⦇
Φ⦇AdjLeft⦈⦇HomDom⦈⦇CId⦈⦇Φ⦇AdjRight⦈⦇ObjMap⦈⦇x⦈⦈
⦈
)"
and "ε⇩C Φ⦇NTDom⦈ = (Φ⦇AdjLeft⦈) ∘⇩C⇩F (Φ⦇AdjRight⦈)"
and "ε⇩C Φ⦇NTCod⦈ = cf_id (Φ⦇AdjLeft⦈⦇HomCod⦈)"
and "ε⇩C Φ⦇NTDGDom⦈ = Φ⦇AdjLeft⦈⦇HomCod⦈"
and "ε⇩C Φ⦇NTDGCod⦈ = Φ⦇AdjLeft⦈⦇HomCod⦈"
unfolding cf_adjunction_counit_def nt_field_simps
by (simp_all add: nat_omega_simps)
context is_cf_adjunction
begin
lemma cf_adjunction_counit_components':
shows "ε⇩C Φ⦇NTMap⦈ =
(
λx∈⇩∘𝔇⦇Obj⦈.
(Φ⦇AdjNT⦈⦇NTMap⦈⦇𝔊⦇ObjMap⦈⦇x⦈, x⦈⇩∙)¯⇩S⇩e⇩t⦇ArrVal⦈⦇ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈⦈
)"
and "ε⇩C Φ⦇NTDom⦈ = 𝔉 ∘⇩C⇩F 𝔊"
and "ε⇩C Φ⦇NTCod⦈ = cf_id 𝔇"
and "ε⇩C Φ⦇NTDGDom⦈ = 𝔇"
and "ε⇩C Φ⦇NTDGCod⦈ = 𝔇"
unfolding cf_adjunction_counit_components
by (cs_concl cs_simp: cat_cs_simps adj_cs_simps)+
mk_VLambda cf_adjunction_counit_components'(1)
|vdomain cf_adjunction_counit_NTMap_vdomain[adj_cs_simps]|
|app cf_adjunction_counit_NTMap_app[adj_cs_simps]|
end
mk_VLambda cf_adjunction_counit_components(1)
|vsv cf_adjunction_counit_NTMap_vsv[adj_cs_intros]|
lemmas [adj_cs_simps] =
is_cf_adjunction.cf_adjunction_counit_NTMap_vdomain
is_cf_adjunction.cf_adjunction_counit_NTMap_app
subsubsection‹Duality for the unit and counit›
lemma (in is_cf_adjunction) cf_adjunction_unit_NTMap_op:
"η⇩C (op_cf_adj Φ)⦇NTMap⦈ = ε⇩C Φ⦇NTMap⦈"
proof-
interpret op_Φ:
is_cf_adjunction α ‹op_cat 𝔇› ‹op_cat ℭ› ‹op_cf 𝔊› ‹op_cf 𝔉› ‹op_cf_adj Φ›
by (rule is_cf_adjunction_op)
show ?thesis
proof
(
rule vsv_eqI,
unfold
cf_adjunction_counit_NTMap_vdomain
op_Φ.cf_adjunction_unit_NTMap_vdomain
)
fix a assume prems: "a ∈⇩∘ op_cat 𝔇⦇Obj⦈"
then have a: "a ∈⇩∘ 𝔇⦇Obj⦈" unfolding cat_op_simps by simp
from is_cf_adjunction_axioms a show
"η⇩C (op_cf_adj Φ)⦇NTMap⦈⦇a⦈ = ε⇩C Φ⦇NTMap⦈⦇a⦈"
by
(
cs_concl
cs_simp: cat_Set_cs_simps cat_cs_simps cat_op_simps adj_cs_simps
cs_intro:
cat_arrow_cs_intros cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
(
simp_all add:
cat_op_simps cf_adjunction_counit_NTMap_vsv cf_adjunction_unit_NTMap_vsv
)
qed
lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_unit_NTMap_op
lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_op:
"ε⇩C (op_cf_adj Φ)⦇NTMap⦈ = η⇩C Φ⦇NTMap⦈"
by
(
rule is_cf_adjunction.cf_adjunction_unit_NTMap_op[
OF is_cf_adjunction_op,
unfolded is_cf_adjunction.cf_adjunction_op_cf_adj_op_cf_adj[
OF is_cf_adjunction_axioms
],
unfolded cat_op_simps,
symmetric
]
)
lemmas [cat_op_simps] = is_cf_adjunction.cf_adjunction_counit_NTMap_op
lemma (in is_cf_adjunction) op_ntcf_cf_adjunction_counit:
"op_ntcf (ε⇩C Φ) = η⇩C (op_cf_adj Φ)"
(is ‹?ε = ?η›)
proof(rule vsv_eqI)
interpret op_Φ:
is_cf_adjunction α ‹op_cat 𝔇› ‹op_cat ℭ› ‹op_cf 𝔊› ‹op_cf 𝔉› ‹op_cf_adj Φ›
by (rule is_cf_adjunction_op)
have dom_lhs: "𝒟⇩∘ ?ε = 5⇩ℕ" unfolding op_ntcf_def by (simp add: nat_omega_simps)
have dom_rhs: "𝒟⇩∘ ?η = 5⇩ℕ"
unfolding cf_adjunction_unit_def by (simp add: nat_omega_simps)
show "𝒟⇩∘ ?ε = 𝒟⇩∘ ?η" unfolding dom_lhs dom_rhs by simp
show "a ∈⇩∘ 𝒟⇩∘ ?ε ⟹ ?ε⦇a⦈ = ?η⦇a⦈" for a
by
(
unfold dom_lhs,
elim_in_numeral,
fold nt_field_simps,
unfold cf_adjunction_unit_NTMap_op,
unfold
cf_adjunction_counit_components'
cf_adjunction_unit_components'
op_Φ.cf_adjunction_counit_components'
op_Φ.cf_adjunction_unit_components'
cat_op_simps
)
simp_all
qed (auto simp: op_ntcf_def cf_adjunction_unit_def)
lemmas [cat_op_simps] = is_cf_adjunction.op_ntcf_cf_adjunction_counit
lemma (in is_cf_adjunction) op_ntcf_cf_adjunction_unit:
"op_ntcf (η⇩C Φ) = ε⇩C (op_cf_adj Φ)"
(is ‹?η = ?ε›)
proof(rule vsv_eqI)
interpret op_Φ:
is_cf_adjunction α ‹op_cat 𝔇› ‹op_cat ℭ› ‹op_cf 𝔊› ‹op_cf 𝔉› ‹op_cf_adj Φ›
by (rule is_cf_adjunction_op)
have dom_lhs: "𝒟⇩∘ ?η = 5⇩ℕ"
unfolding op_ntcf_def by (simp add: nat_omega_simps)
have dom_rhs: "𝒟⇩∘ ?ε = 5⇩ℕ"
unfolding cf_adjunction_counit_def by (simp add: nat_omega_simps)
show "𝒟⇩∘ ?η = 𝒟⇩∘ ?ε" unfolding dom_lhs dom_rhs by simp
show "a ∈⇩∘ 𝒟⇩∘ ?η ⟹ ?η⦇a⦈ = ?ε⦇a⦈" for a
by
(
unfold dom_lhs,
elim_in_numeral,
fold nt_field_simps,
unfold cf_adjunction_counit_NTMap_op,
unfold
cf_adjunction_counit_components'
cf_adjunction_unit_components'
op_Φ.cf_adjunction_counit_components'
op_Φ.cf_adjunction_unit_components'
cat_op_simps
)
simp_all
qed (auto simp: op_ntcf_def cf_adjunction_counit_def)
lemmas [cat_op_simps] = is_cf_adjunction.op_ntcf_cf_adjunction_unit
subsubsection‹Natural transformation map›
lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_is_arr:
assumes "x ∈⇩∘ 𝔇⦇Obj⦈"
shows "ε⇩C Φ⦇NTMap⦈⦇x⦈ : 𝔉⦇ObjMap⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈ ↦⇘𝔇⇙ x"
proof-
from assms have x: "x ∈⇩∘ op_cat 𝔇⦇Obj⦈" unfolding cat_op_simps by simp
show ?thesis
by
(
rule is_cf_adjunction.cf_adjunction_unit_NTMap_is_arr[
OF is_cf_adjunction_op x,
unfolded cf_adjunction_unit_NTMap_op cat_op_simps
]
)
qed
lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_is_arr':
assumes "x ∈⇩∘ 𝔇⦇Obj⦈"
and "a = 𝔉⦇ObjMap⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈"
and "b = x"
and "𝔇' = 𝔇"
shows "ε⇩C Φ⦇NTMap⦈⦇x⦈ : a ↦⇘𝔇'⇙ b"
using assms(1) unfolding assms(2-4) by (rule cf_adjunction_counit_NTMap_is_arr)
lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_counit_NTMap_is_arr'
lemma (in is_cf_adjunction) cf_adjunction_counit_NTMap_vrange:
"ℛ⇩∘ (ε⇩C Φ⦇NTMap⦈) ⊆⇩∘ 𝔇⦇Arr⦈"
by
(
rule is_cf_adjunction.cf_adjunction_unit_NTMap_vrange[
OF is_cf_adjunction_op,
unfolded cf_adjunction_unit_NTMap_op cat_op_simps
]
)
subsubsection‹Counit is a natural transformation›
lemma (in is_cf_adjunction) cf_adjunction_counit_is_ntcf:
"ε⇩C Φ : 𝔉 ∘⇩C⇩F 𝔊 ↦⇩C⇩F cf_id 𝔇 : 𝔇 ↦↦⇩C⇘α⇙ 𝔇"
proof-
from is_cf_adjunction.cf_adjunction_unit_is_ntcf[OF is_cf_adjunction_op] have
"ε⇩C Φ :
op_cf (op_cf 𝔉 ∘⇩C⇩F op_cf 𝔊) ↦⇩C⇩F op_cf (cf_id (op_cat 𝔇)) :
op_cat (op_cat 𝔇) ↦↦⇩C⇘α⇙ op_cat (op_cat 𝔇)"
unfolding
is_cf_adjunction.op_ntcf_cf_adjunction_unit[
OF is_cf_adjunction_op, unfolded cat_op_simps, symmetric
]
by (rule is_ntcf.is_ntcf_op)
then show ?thesis unfolding cat_op_simps .
qed
lemma (in is_cf_adjunction) cf_adjunction_counit_is_ntcf':
assumes "𝔖 = 𝔉 ∘⇩C⇩F 𝔊"
and "𝔖' = cf_id 𝔇"
and "𝔄 = 𝔇"
and "𝔅 = 𝔇"
shows "ε⇩C Φ : 𝔖 ↦⇩C⇩F 𝔖' : 𝔄 ↦↦⇩C⇘α⇙ 𝔅"
unfolding assms by (rule cf_adjunction_counit_is_ntcf)
lemmas [adj_cs_intros] = is_cf_adjunction.cf_adjunction_counit_is_ntcf'
subsubsection‹Every component of a counit is a universal arrow›
text‹
The lemmas in this subsection are based on elements of the statement of
Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›
lemma (in is_cf_adjunction) cf_adj_umap_fo_counit:
assumes "x ∈⇩∘ 𝔇⦇Obj⦈" and "a ∈⇩∘ ℭ⦇Obj⦈"
shows "op_cf_adj Φ⦇AdjNT⦈⦇NTMap⦈⦇x, a⦈⇩∙ =
umap_fo 𝔉 x (𝔊⦇ObjMap⦈⦇x⦈) (ε⇩C Φ⦇NTMap⦈⦇x⦈) a"
by
(
rule is_cf_adjunction.cf_adj_umap_of_unit[
OF is_cf_adjunction_op,
unfolded cat_op_simps,
OF assms,
unfolded cf_adjunction_unit_NTMap_op
]
)
lemma (in is_cf_adjunction) cf_adjunction_counit_component_is_ua_fo:
assumes "x ∈⇩∘ 𝔇⦇Obj⦈"
shows "universal_arrow_fo 𝔉 x (𝔊⦇ObjMap⦈⦇x⦈) (ε⇩C Φ⦇NTMap⦈⦇x⦈)"
by
(
rule is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
OF is_cf_adjunction_op,
unfolded cat_op_simps,
OF assms,
unfolded cf_adjunction_unit_NTMap_op
]
)
subsection‹Counit-unit equations›
text‹
The following equations appear as part of the statement of
Theorem 1 in Chapter IV-1 in \cite{mac_lane_categories_2010}.
These equations also appear in \cite{noauthor_wikipedia_2001},
where they are named ‹counit-unit equations›.
›
lemma (in is_cf_adjunction) cf_adjunction_counit_unit:
"(𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ε⇩C Φ) ∙⇩N⇩T⇩C⇩F (η⇩C Φ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊) = ntcf_id 𝔊"
(is ‹(𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?ε) ∙⇩N⇩T⇩C⇩F (?η ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊) = ntcf_id 𝔊›)
proof(rule ntcf_eqI)
from is_cf_adjunction_axioms show
"(𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?ε) ∙⇩N⇩T⇩C⇩F (?η ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊) : 𝔊 ↦⇩C⇩F 𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
show "ntcf_id 𝔊 : 𝔊 ↦⇩C⇩F 𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
by (rule is_functor.cf_ntcf_id_is_ntcf[OF RL.is_functor_axioms])
from is_cf_adjunction_axioms have dom_lhs:
"𝒟⇩∘ (((𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?ε) ∙⇩N⇩T⇩C⇩F (?η ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊))⦇NTMap⦈) = 𝔇⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
from is_cf_adjunction_axioms have dom_rhs: "𝒟⇩∘ (ntcf_id 𝔊⦇NTMap⦈) = 𝔇⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros)
show "((𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?ε) ∙⇩N⇩T⇩C⇩F (?η ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊))⦇NTMap⦈ = ntcf_id 𝔊⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ∈⇩∘ 𝔇⦇Obj⦈"
let ?φ_aa = ‹Φ⦇AdjNT⦈⦇NTMap⦈⦇𝔊⦇ObjMap⦈⦇a⦈, a⦈⇩∙›
have "category α (cat_Set α)"
by (rule category_cat_Set)
from is_cf_adjunction_axioms prems
L.category_axioms R.category_axioms
L.category_op R.category_op
LR.is_functor_axioms RL.is_functor_axioms
category_cat_Set
have
"?φ_aa⦇ArrVal⦈⦇?ε⦇NTMap⦈⦇a⦈⦈ =
(?φ_aa ∘⇩A⇘cat_Set α⇙ ?φ_aa¯⇩C⇘cat_Set α⇙)⦇ArrVal⦈⦇ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇a⦈⦈⦈"
by
(
cs_concl
cs_simp:
𝒵.cat_Set_Comp_ArrVal
cat_Set_the_inverse[symmetric]
cat_cs_simps adj_cs_simps cat_prod_cs_simps
cs_intro:
cat_arrow_cs_intros
cat_cs_intros
cat_op_intros
adj_cs_intros
cat_prod_cs_intros
)
also from is_cf_adjunction_axioms prems
L.category_axioms R.category_axioms
L.category_op R.category_op
LR.is_functor_axioms RL.is_functor_axioms
category_cat_Set
have "… = ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇a⦈⦈"
by (
cs_concl
cs_simp: cat_cs_simps category.cat_the_inverse_Comp_CId
cs_intro:
cat_arrow_cs_intros cat_cs_intros cat_op_intros cat_prod_cs_intros
)
finally have [cat_cs_simps]:
"(Φ⦇AdjNT⦈⦇NTMap⦈⦇𝔊⦇ObjMap⦈⦇a⦈, a⦈⇩∙)⦇ArrVal⦈⦇?ε⦇NTMap⦈⦇a⦈⦈ =
ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇a⦈⦈"
by simp
from
prems is_cf_adjunction_axioms
L.category_axioms R.category_axioms
show "((𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?ε) ∙⇩N⇩T⇩C⇩F (?η ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊))⦇NTMap⦈⦇a⦈ = ntcf_id 𝔊⦇NTMap⦈⦇a⦈"
by
(
cs_concl
cs_simp:
cat_Set_the_inverse[symmetric]
cf_adj_Comp_commute_RL
cat_cs_simps
adj_cs_simps
cat_prod_cs_simps
cat_op_simps
cs_intro:
cat_arrow_cs_intros
cat_cs_intros
adj_cs_intros
cat_prod_cs_intros
cat_op_intros
)
qed (auto intro: cat_cs_intros)
qed simp_all
lemmas [adj_cs_simps] = is_cf_adjunction.cf_adjunction_counit_unit
lemma (in is_cf_adjunction) cf_adjunction_unit_counit:
"(ε⇩C Φ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉) ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F η⇩C Φ) = ntcf_id 𝔉"
(is ‹(?ε ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉) ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?η) = ntcf_id 𝔉›)
proof-
from is_cf_adjunction_axioms have 𝔉η:
"𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?η : 𝔉 ↦⇩C⇩F 𝔉 ∘⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
from is_cf_adjunction_axioms have ε𝔉:
"?ε ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉 : 𝔉 ∘⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 ↦⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros adj_cs_intros)
from 𝔉η ε𝔉 have ε𝔉_𝔉η:
"(?ε ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉) ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?η) : 𝔉 ↦⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
by (cs_concl cs_intro: cat_cs_intros)
from
is_cf_adjunction.cf_adjunction_counit_unit[
OF is_cf_adjunction_op,
unfolded
op_ntcf_cf_adjunction_unit[symmetric]
op_ntcf_cf_adjunction_counit[symmetric]
op_ntcf_cf_ntcf_comp[symmetric]
op_ntcf_ntcf_cf_comp[symmetric]
op_ntcf_ntcf_vcomp[symmetric]
op_ntcf_ntcf_vcomp[symmetric, OF ε𝔉 𝔉η]
LR.cf_ntcf_id_op_cf
]
have
"op_ntcf (op_ntcf ((?ε ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉) ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?η))) =
op_ntcf (op_ntcf (ntcf_id 𝔉))"
by simp
from this is_cf_adjunction_axioms ε𝔉_𝔉η show ?thesis
by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
qed
lemmas [adj_cs_simps] = is_cf_adjunction.cf_adjunction_unit_counit
subsection‹
Construction of an adjunction from universal morphisms
from objects to functors
›
text‹
The subsection presents the construction of an adjunction given
a structured collection of universal morphisms from objects to functors.
The content of this subsection follows the statement and the proof
of Theorem 2-i in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›
subsubsection‹
The natural transformation associated with the adjunction
constructed from universal morphisms from objects to functors
›
definition cf_adjunction_AdjNT_of_unit :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
where "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η =
[
(λcd∈⇩∘(op_cat (𝔉⦇HomDom⦈) ×⇩C 𝔉⦇HomCod⦈)⦇Obj⦈.
umap_of 𝔊 (cd⦇0⦈) (𝔉⦇ObjMap⦈⦇cd⦇0⦈⦈) (η⦇NTMap⦈⦇cd⦇0⦈⦈) (cd⦇1⇩ℕ⦈)),
Hom⇩O⇩.⇩C⇘α⇙𝔉⦇HomCod⦈(𝔉-,-),
Hom⇩O⇩.⇩C⇘α⇙𝔉⦇HomDom⦈(-,𝔊-),
op_cat (𝔉⦇HomDom⦈) ×⇩C (𝔉⦇HomCod⦈),
cat_Set α
]⇩∘"
text‹Components.›
lemma cf_adjunction_AdjNT_of_unit_components:
shows "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈ =
(
λcd∈⇩∘(op_cat (𝔉⦇HomDom⦈) ×⇩C 𝔉⦇HomCod⦈)⦇Obj⦈.
umap_of 𝔊 (cd⦇0⦈) (𝔉⦇ObjMap⦈⦇cd⦇0⦈⦈) (η⦇NTMap⦈⦇cd⦇0⦈⦈) (cd⦇1⇩ℕ⦈)
)"
and "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTDom⦈ = Hom⇩O⇩.⇩C⇘α⇙𝔉⦇HomCod⦈(𝔉-,-)"
and "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTCod⦈ = Hom⇩O⇩.⇩C⇘α⇙𝔉⦇HomDom⦈(-,𝔊-)"
and "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTDGDom⦈ =
op_cat (𝔉⦇HomDom⦈) ×⇩C (𝔉⦇HomCod⦈)"
and "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTDGCod⦈ = cat_Set α"
unfolding cf_adjunction_AdjNT_of_unit_def nt_field_simps
by (simp_all add: nat_omega_simps)
subsubsection‹Natural transformation map›
lemma cf_adjunction_AdjNT_of_unit_NTMap_vsv[adj_cs_intros]:
"vsv (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈)"
unfolding cf_adjunction_AdjNT_of_unit_components by simp
lemma cf_adjunction_AdjNT_of_unit_NTMap_vdomain[adj_cs_simps]:
assumes "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
shows "𝒟⇩∘ (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈) = (op_cat ℭ ×⇩C 𝔇)⦇Obj⦈"
proof-
interpret is_functor α ℭ 𝔇 𝔉 by (rule assms(1))
show ?thesis
unfolding cf_adjunction_AdjNT_of_unit_components
by (simp add: cat_cs_simps)
qed
lemma cf_adjunction_AdjNT_of_unit_NTMap_app[adj_cs_simps]:
assumes "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇" and "c ∈⇩∘ ℭ⦇Obj⦈" and "d ∈⇩∘ 𝔇⦇Obj⦈"
shows
"cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈⦇c, d⦈⇩∙ =
umap_of 𝔊 c (𝔉⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈) d"
proof-
interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(1))
from assms have "[c, d]⇩∘ ∈⇩∘ (op_cat ℭ ×⇩C 𝔇)⦇Obj⦈"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_prod_cs_intros)
then show "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈ ⦇c, d⦈⇩∙ =
umap_of 𝔊 c (𝔉⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈) d"
unfolding cf_adjunction_AdjNT_of_unit_components
by (simp add: nat_omega_simps cat_cs_simps)
qed
lemma cf_adjunction_AdjNT_of_unit_NTMap_vrange:
assumes "category α ℭ"
and "category α 𝔇"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "η : cf_id ℭ ↦⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
shows "ℛ⇩∘ (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈) ⊆⇩∘ cat_Set α⦇Arr⦈"
proof-
interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(3))
show ?thesis
proof
(
rule vsv.vsv_vrange_vsubset,
unfold cf_adjunction_AdjNT_of_unit_NTMap_vdomain[OF assms(3)]
)
show "vsv (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈)"
by (intro adj_cs_intros)
fix cd assume prems: "cd ∈⇩∘ (op_cat ℭ ×⇩C 𝔇)⦇Obj⦈"
then obtain c d where cd_def: "cd = [c, d]⇩∘"
and c: "c ∈⇩∘ ℭ⦇Obj⦈"
and d: "d ∈⇩∘ 𝔇⦇Obj⦈"
by
(
auto
simp: cat_op_simps
elim:
cat_prod_2_ObjE[OF 𝔉.HomDom.category_op 𝔉.HomCod.category_axioms]
)
from assms c d show
"cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈⦇cd⦈ ∈⇩∘ cat_Set α⦇Arr⦈"
unfolding cd_def
by (cs_concl cs_simp: cat_cs_simps adj_cs_simps cs_intro: cat_cs_intros)
qed
qed
subsubsection‹
Adjunction constructed from universal morphisms
from objects to functors is an adjunction
›
lemma cf_adjunction_AdjNT_of_unit_is_ntcf:
assumes "category α ℭ"
and "category α 𝔇"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "η : cf_id ℭ ↦⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
shows "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η :
Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉-,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-) :
op_cat ℭ ×⇩C 𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
proof-
interpret ℭ: category α ℭ by (rule assms(1))
interpret 𝔇: category α 𝔇 by (rule assms(2))
interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(3))
interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(4))
interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘⇩C⇩F 𝔉› η by (rule assms(5))
show ?thesis
proof(intro is_ntcfI')
show "vfsequence (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η)"
unfolding cf_adjunction_AdjNT_of_unit_def by simp
show "vcard (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η) = 5⇩ℕ"
unfolding cf_adjunction_AdjNT_of_unit_def by (simp add: nat_omega_simps)
from assms(2,3) show
"Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉-,-) : op_cat ℭ ×⇩C 𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_intro: cat_cs_intros)
from assms show "Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-) : op_cat ℭ ×⇩C 𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_intro: cat_cs_intros)
show "vsv (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈)"
by (intro adj_cs_intros)
from assms show
"𝒟⇩∘ (cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈) = (op_cat ℭ ×⇩C 𝔇)⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps adj_cs_simps)
show "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈⦇cd⦈ :
Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉-,-)⦇ObjMap⦈⦇cd⦈ ↦⇘cat_Set α⇙
Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-)⦇ObjMap⦈⦇cd⦈"
if "cd ∈⇩∘ (op_cat ℭ ×⇩C 𝔇)⦇Obj⦈" for cd
proof-
from that obtain c d
where cd_def: "cd = [c, d]⇩∘" and c: "c ∈⇩∘ ℭ⦇Obj⦈" and d: "d ∈⇩∘ 𝔇⦇Obj⦈"
by
(
auto
simp: cat_op_simps
elim: cat_prod_2_ObjE[OF ℭ.category_op 𝔇.category_axioms]
)
from assms c d show ?thesis
unfolding cd_def
by
(
cs_concl
cs_simp: adj_cs_simps cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
show
"cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈⦇c'd'⦈ ∘⇩A⇘cat_Set α⇙
Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉-,-)⦇ArrMap⦈⦇gf⦈ =
Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-)⦇ArrMap⦈⦇gf⦈ ∘⇩A⇘cat_Set α⇙
cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⦇NTMap⦈⦇cd⦈"
if "gf : cd ↦⇘op_cat ℭ ×⇩C 𝔇⇙ c'd'" for cd c'd' gf
proof-
from that obtain g f c c' d d'
where gf_def: "gf = [g, f]⇩∘"
and cd_def: "cd = [c, d]⇩∘"
and c'd'_def: "c'd' = [c', d']⇩∘"
and g: "g : c' ↦⇘ℭ⇙ c"
and f: "f : d ↦⇘𝔇⇙ d'"
by
(
auto
simp: cat_op_simps
elim: cat_prod_2_is_arrE[OF ℭ.category_op 𝔇.category_axioms]
)
from assms g f that show ?thesis
unfolding gf_def cd_def c'd'_def
by
(
cs_concl
cs_simp: cf_umap_of_cf_hom_unit_commute adj_cs_simps cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
)
qed
qed (auto simp: cf_adjunction_AdjNT_of_unit_components cat_cs_simps)
qed
lemma cf_adjunction_AdjNT_of_unit_is_ntcf'[adj_cs_intros]:
assumes "category α ℭ"
and "category α 𝔇"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "η : cf_id ℭ ↦⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
and "𝔖 = Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉-,-)"
and "𝔖' = Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-)"
and "𝔄 = op_cat ℭ ×⇩C 𝔇"
and "𝔅 = cat_Set α"
shows "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η : 𝔖 ↦⇩C⇩F 𝔖' : 𝔄 ↦↦⇩C⇘α⇙ 𝔅"
using assms(1-5) unfolding assms(6-9)
by (rule cf_adjunction_AdjNT_of_unit_is_ntcf)
subsubsection‹
Adjunction constructed from universal morphisms from objects to functors
›
definition cf_adjunction_of_unit :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
where "cf_adjunction_of_unit α 𝔉 𝔊 η =
[𝔉, 𝔊, cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η]⇩∘"
text‹Components.›
lemma cf_adjunction_of_unit_components:
shows [adj_cs_simps]: "cf_adjunction_of_unit α 𝔉 𝔊 η⦇AdjLeft⦈ = 𝔉"
and [adj_cs_simps]: "cf_adjunction_of_unit α 𝔉 𝔊 η⦇AdjRight⦈ = 𝔊"
and "cf_adjunction_of_unit α 𝔉 𝔊 η⦇AdjNT⦈ =
cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η"
unfolding cf_adjunction_of_unit_def adj_field_simps
by (simp_all add: nat_omega_simps)
text‹Natural transformation map.›
lemma cf_adjunction_of_unit_AdjNT_NTMap_vdomain[adj_cs_simps]:
assumes "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
shows "𝒟⇩∘ (cf_adjunction_of_unit α 𝔉 𝔊 η⦇AdjNT⦈⦇NTMap⦈) =
(op_cat ℭ ×⇩C 𝔇)⦇Obj⦈"
using assms
unfolding cf_adjunction_of_unit_components(3)
by (rule cf_adjunction_AdjNT_of_unit_NTMap_vdomain)
lemma cf_adjunction_of_unit_AdjNT_NTMap_app[adj_cs_simps]:
assumes "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇" and "c ∈⇩∘ ℭ⦇Obj⦈" and "d ∈⇩∘ 𝔇⦇Obj⦈"
shows
"cf_adjunction_of_unit α 𝔉 𝔊 η⦇AdjNT⦈⦇NTMap⦈⦇c, d⦈⇩∙ =
umap_of 𝔊 c (𝔉⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈) d"
using assms
unfolding cf_adjunction_of_unit_components(3)
by (rule cf_adjunction_AdjNT_of_unit_NTMap_app)
text‹
The adjunction constructed from universal morphisms from objects to
functors is an adjunction.
›
lemma cf_adjunction_of_unit_is_cf_adjunction:
assumes "category α ℭ"
and "category α 𝔇"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "η : cf_id ℭ ↦⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
and "⋀x. x ∈⇩∘ ℭ⦇Obj⦈ ⟹ universal_arrow_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⦇NTMap⦈⦇x⦈)"
shows "cf_adjunction_of_unit α 𝔉 𝔊 η : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "η⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η) = η"
proof-
interpret ℭ: category α ℭ by (rule assms(1))
interpret 𝔇: category α 𝔇 by (rule assms(2))
interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(3))
interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(4))
interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘⇩C⇩F 𝔉› η by (rule assms(5))
show caou_η: "cf_adjunction_of_unit α 𝔉 𝔊 η : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
proof
(
intro
is_cf_adjunctionI[OF _ _ assms(1-4)]
is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf[
OF ℭ.category_op 𝔇.category_axioms
],
unfold cat_op_simps cf_adjunction_of_unit_components
)
show caou_η: "cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η :
Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉-,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-) :
op_cat ℭ ×⇩C 𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
unfolding cf_adjunction_of_unit_components
by (rule cf_adjunction_AdjNT_of_unit_is_ntcf[OF assms(1-5)])
fix a assume prems: "a ∈⇩∘ ℭ⦇Obj⦈"
have ua_of_ηa:
"ntcf_ua_of α 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈) :
Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉⦇ObjMap⦈⦇a⦈,-) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) ∘⇩C⇩F 𝔊 :
𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
by
(
rule is_functor.cf_ntcf_ua_of_is_iso_ntcf[
OF assms(4) assms(6)[OF prems]
]
)
have [adj_cs_simps]:
"cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⇘op_cat ℭ,𝔇⇙(a,-)⇩N⇩T⇩C⇩F =
ntcf_ua_of α 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)"
proof(rule ntcf_eqI)
from assms(1-5) caou_η prems show lhs:
"cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⇘op_cat ℭ,𝔇⇙(a,-)⇩N⇩T⇩C⇩F :
Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉⦇ObjMap⦈⦇a⦈,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) ∘⇩C⇩F 𝔊 :
𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
from ua_of_ηa show rhs:
"ntcf_ua_of α 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈) :
Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉⦇ObjMap⦈⦇a⦈,-) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙ℭ(a,-) ∘⇩C⇩F 𝔊 :
𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_intro: ntcf_cs_intros)
from lhs have dom_lhs:
"𝒟⇩∘ ((cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⇘op_cat ℭ,𝔇⇙(a,-)⇩N⇩T⇩C⇩F)⦇NTMap⦈) =
𝔇⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
from lhs assms(4) have dom_rhs:
"𝒟⇩∘ (ntcf_ua_of α 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)⦇NTMap⦈) = 𝔇⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
show
"(cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⇘op_cat ℭ,𝔇⇙(a,-)⇩N⇩T⇩C⇩F)⦇NTMap⦈ =
ntcf_ua_of α 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix d assume prems': "d ∈⇩∘ 𝔇⦇Obj⦈"
from assms(3,4) prems prems' show
"(cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⇘op_cat ℭ,𝔇⇙(a,-)⇩N⇩T⇩C⇩F)⦇NTMap⦈⦇d⦈ =
ntcf_ua_of α 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)⦇NTMap⦈⦇d⦈"
by (cs_concl cs_simp: adj_cs_simps cat_cs_simps)
qed (simp_all add: bnt_proj_snd_NTMap_vsv 𝔊.ntcf_ua_of_NTMap_vsv)
qed simp_all
from assms(1-5) assms(6)[OF prems] prems show
"cf_adjunction_AdjNT_of_unit α 𝔉 𝔊 η⇘op_cat ℭ,𝔇⇙(a,-)⇩N⇩T⇩C⇩F :
Hom⇩O⇩.⇩C⇘α⇙𝔇(𝔉-,-)⇘op_cat ℭ,𝔇⇙(a,-)⇩C⇩F ↦⇩C⇩F⇩.⇩i⇩s⇩o
Hom⇩O⇩.⇩C⇘α⇙ℭ(-,𝔊-)⇘op_cat ℭ,𝔇⇙(a,-)⇩C⇩F :
𝔇 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_simp: adj_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: cf_adjunction_of_unit_def nat_omega_simps)
show "η⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η) = η"
proof(rule ntcf_eqI)
from caou_η show lhs:
"η⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η) :
cf_id ℭ ↦⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_intro: adj_cs_intros)
show rhs: "η : cf_id ℭ ↦⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
by (auto intro: cat_cs_intros)
from lhs have dom_lhs:
"𝒟⇩∘ (η⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η)⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
have dom_rhs: "𝒟⇩∘ (η⦇NTMap⦈) = ℭ⦇Obj⦈" by (auto simp: cat_cs_simps)
show "η⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η)⦇NTMap⦈ = η⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ∈⇩∘ ℭ⦇Obj⦈"
from assms(1-5) prems caou_η show
"η⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η)⦇NTMap⦈⦇a⦈ = η⦇NTMap⦈⦇a⦈"
by
(
cs_concl
cs_simp:
adj_cs_simps cat_cs_simps cf_adjunction_of_unit_components(3)
cs_intro: cat_cs_intros
)
qed (auto intro: adj_cs_intros)
qed simp_all
qed
subsection‹
Construction of an adjunction from a functor and universal morphisms
from objects to functors
›
text‹
The subsection presents the construction of an adjunction given
a functor and a structured collection of universal morphisms
from objects to functors.
The content of this subsection follows the statement and the proof
of Theorem 2-ii in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›
subsubsection‹Left adjoint›
definition cf_la_of_ra :: "(V ⇒ V) ⇒ V ⇒ V ⇒ V"
where "cf_la_of_ra F 𝔊 η =
[
(λx∈⇩∘𝔊⦇HomCod⦈⦇Obj⦈. F x),
(
λh∈⇩∘𝔊⦇HomCod⦈⦇Arr⦈. THE f'.
f' : F (𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈) ↦⇘𝔊⦇HomDom⦈⇙ F (𝔊⦇HomCod⦈⦇Cod⦈⦇h⦈) ∧
η⦇NTMap⦈⦇𝔊⦇HomCod⦈⦇Cod⦈⦇h⦈⦈ ∘⇩A⇘𝔊⦇HomCod⦈⇙ h =
(
umap_of
𝔊
(𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈)
(F (𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈))
(η⦇NTMap⦈⦇𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈⦈)
(F (𝔊⦇HomCod⦈⦇Cod⦈⦇h⦈))
)⦇ArrVal⦈⦇f'⦈
),
𝔊⦇HomCod⦈,
𝔊⦇HomDom⦈
]⇩∘"
text‹Components.›
lemma cf_la_of_ra_components:
shows "cf_la_of_ra F 𝔊 η⦇ObjMap⦈ = (λx∈⇩∘𝔊⦇HomCod⦈⦇Obj⦈. F x)"
and "cf_la_of_ra F 𝔊 η⦇ArrMap⦈ =
(
λh∈⇩∘𝔊⦇HomCod⦈⦇Arr⦈. THE f'.
f' : F (𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈) ↦⇘𝔊⦇HomDom⦈⇙ F (𝔊⦇HomCod⦈⦇Cod⦈⦇h⦈) ∧
η⦇NTMap⦈⦇𝔊⦇HomCod⦈⦇Cod⦈⦇h⦈⦈ ∘⇩A⇘𝔊⦇HomCod⦈⇙ h =
(
umap_of
𝔊
(𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈)
(F (𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈))
(η⦇NTMap⦈⦇𝔊⦇HomCod⦈⦇Dom⦈⦇h⦈⦈)
(F (𝔊⦇HomCod⦈⦇Cod⦈⦇h⦈))
)⦇ArrVal⦈⦇f'⦈
)"
and "cf_la_of_ra F 𝔊 η⦇HomDom⦈ = 𝔊⦇HomCod⦈"
and "cf_la_of_ra F 𝔊 η⦇HomCod⦈ = 𝔊⦇HomDom⦈"
unfolding cf_la_of_ra_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsection‹Object map›
mk_VLambda cf_la_of_ra_components(1)
|vsv cf_la_of_ra_ObjMap_vsv[adj_cs_intros]|
mk_VLambda (in is_functor)
cf_la_of_ra_components(1)[where ?𝔊=𝔉, unfolded cf_HomCod]
|vdomain cf_la_of_ra_ObjMap_vdomain[adj_cs_simps]|
|app cf_la_of_ra_ObjMap_app[adj_cs_simps]|
lemmas [adj_cs_simps] =
is_functor.cf_la_of_ra_ObjMap_vdomain
is_functor.cf_la_of_ra_ObjMap_app
subsubsection‹Arrow map›
mk_VLambda cf_la_of_ra_components(2)
|vsv cf_la_of_ra_ArrMap_vsv[adj_cs_intros]|
mk_VLambda (in is_functor)
cf_la_of_ra_components(2)[where ?𝔊=𝔉, unfolded cf_HomCod cf_HomDom]
|vdomain cf_la_of_ra_ArrMap_vdomain[adj_cs_simps]|
|app cf_la_of_ra_ArrMap_app|
lemmas [adj_cs_simps] = is_functor.cf_la_of_ra_ArrMap_vdomain
lemma (in is_functor) cf_la_of_ra_ArrMap_app':
assumes "h : a ↦⇘𝔅⇙ b"
shows
"cf_la_of_ra F 𝔉 η⦇ArrMap⦈⦇h⦈ =
(
THE f'.
f' : F a ↦⇘𝔄⇙ F b ∧
η⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔅⇙ h = umap_of 𝔉 a (F a) (η⦇NTMap⦈⦇a⦈) (F b)⦇ArrVal⦈⦇f'⦈
)"
proof-
from assms have h: "h ∈⇩∘ 𝔅⦇Arr⦈" by (simp add: cat_cs_intros)
from assms have h_Dom: "𝔅⦇Dom⦈⦇h⦈ = a" and h_Cod: "𝔅⦇Cod⦈⦇h⦈ = b"
by (simp_all add: cat_cs_simps)
show ?thesis by (rule cf_la_of_ra_ArrMap_app[OF h, unfolded h_Dom h_Cod])
qed
lemma cf_la_of_ra_ArrMap_app_unique:
assumes "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "f : a ↦⇘ℭ⇙ b"
and "universal_arrow_of 𝔊 a (cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)"
and "universal_arrow_of 𝔊 b (cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇b⦈) (η⦇NTMap⦈⦇b⦈)"
shows "cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈ : F a ↦⇘𝔇⇙ F b"
and "η⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ f = umap_of
𝔊 a (F a) (η⦇NTMap⦈⦇a⦈) (F b)⦇ArrVal⦈⦇cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈⦈"
and "⋀f'.
⟦
f' : F a ↦⇘𝔇⇙ F b;
η⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ f = umap_of 𝔊 a (F a) (η⦇NTMap⦈⦇a⦈) (F b)⦇ArrVal⦈⦇f'⦈
⟧ ⟹ cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈ = f'"
proof-
interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(1))
from assms(2) have a: "a ∈⇩∘ ℭ⦇Obj⦈" and b: "b ∈⇩∘ ℭ⦇Obj⦈"
by (simp_all add: cat_cs_intros)
note ua_η_a = 𝔊.universal_arrow_ofD[OF assms(3)]
note ua_η_b = 𝔊.universal_arrow_ofD[OF assms(4)]
from ua_η_b(2) have [cat_cs_intros]:
"⟦ c = b; c' = 𝔊⦇ObjMap⦈⦇cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇b⦈⦈ ⟧ ⟹
η⦇NTMap⦈⦇b⦈ : c ↦⇘ℭ⇙ c'"
for c c'
by auto
from assms(1,2) ua_η_a(2) have ηa_f:
"η⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ f : a ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇b⦈⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(1,2) have lara_a: "cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇a⦈ = F a"
and lara_b: "cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇b⦈ = F b"
by (cs_concl cs_simp: adj_cs_simps cs_intro: cat_cs_intros)+
from theD
[
OF
ua_η_a(3)[OF ua_η_b(1) ηa_f, unfolded lara_a lara_b]
𝔊.cf_la_of_ra_ArrMap_app'[OF assms(2), of F η]
]
show "cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈ : F a ↦⇘𝔇⇙ F b"
and "η⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ f = umap_of
𝔊 a (F a) (η⦇NTMap⦈⦇a⦈) (F b)⦇ArrVal⦈⦇cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈⦈"
and "⋀f'.
⟦
f' : F a ↦⇘𝔇⇙ F b;
η⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ f = umap_of 𝔊 a (F a) (η⦇NTMap⦈⦇a⦈) (F b)⦇ArrVal⦈⦇f'⦈
⟧ ⟹ cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈ = f'"
by blast+
qed
lemma cf_la_of_ra_ArrMap_app_is_arr[adj_cs_intros]:
assumes "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "f : a ↦⇘ℭ⇙ b"
and "universal_arrow_of 𝔊 a (cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)"
and "universal_arrow_of 𝔊 b (cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇b⦈) (η⦇NTMap⦈⦇b⦈)"
and "Fa = F a"
and "Fb = F b"
shows "cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇f⦈ : Fa ↦⇘𝔇⇙ Fb"
using assms(1-4) unfolding assms(5,6) by (rule cf_la_of_ra_ArrMap_app_unique)
subsubsection‹
An adjunction constructed from a functor and universal morphisms
from objects to functors is an adjunction
›
lemma cf_la_of_ra_is_functor:
assumes "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "⋀c. c ∈⇩∘ ℭ⦇Obj⦈ ⟹ F c ∈⇩∘ 𝔇⦇Obj⦈"
and "⋀c. c ∈⇩∘ ℭ⦇Obj⦈ ⟹
universal_arrow_of 𝔊 c (cf_la_of_ra F 𝔊 η⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈)"
and "⋀c c' h. h : c ↦⇘ℭ⇙ c' ⟹
𝔊⦇ArrMap⦈⦇cf_la_of_ra F 𝔊 η⦇ArrMap⦈⦇h⦈⦈ ∘⇩A⇘ℭ⇙ (η⦇NTMap⦈⦇c⦈) =
(η⦇NTMap⦈⦇c'⦈) ∘⇩A⇘ℭ⇙ h"
shows "cf_la_of_ra F 𝔊 η : ℭ ↦↦⇩C⇘α⇙ 𝔇" (is ‹?𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇›)
proof-
interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(1))
show "cf_la_of_ra F 𝔊 η : ℭ ↦↦⇩C⇘α⇙ 𝔇"
proof(rule is_functorI')
show "vfsequence ?𝔉" unfolding cf_la_of_ra_def by auto
show "vcard ?𝔉 = 4⇩ℕ"
unfolding cf_la_of_ra_def by (simp add: nat_omega_simps)
show "ℛ⇩∘ (?𝔉⦇ObjMap⦈) ⊆⇩∘ 𝔇⦇Obj⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold 𝔊.cf_la_of_ra_ObjMap_vdomain)
fix x assume "x ∈⇩∘ ℭ⦇Obj⦈"
with assms(1) show "?𝔉⦇ObjMap⦈⦇x⦈ ∈⇩∘ 𝔇⦇Obj⦈"
by (cs_concl cs_simp: adj_cs_simps cs_intro: assms(2))
qed (auto intro: adj_cs_intros)
show "?𝔉⦇ArrMap⦈⦇f⦈ : ?𝔉⦇ObjMap⦈⦇a⦈ ↦⇘𝔇⇙ ?𝔉⦇ObjMap⦈⦇b⦈"
if "f : a ↦⇘ℭ⇙ b" for a b f
proof-
from that have a: "a ∈⇩∘ ℭ⦇Obj⦈" and b: "b ∈⇩∘ ℭ⦇Obj⦈"
by (simp_all add: cat_cs_intros)
have ua_η_a: "universal_arrow_of 𝔊 a (?𝔉⦇ObjMap⦈⦇a⦈) (η⦇NTMap⦈⦇a⦈)"
and ua_η_b: "universal_arrow_of 𝔊 b (?𝔉⦇ObjMap⦈⦇b⦈) (η⦇NTMap⦈⦇b⦈)"
by (intro assms(3)[OF a] assms(3)[OF b])+
from a b cf_la_of_ra_ArrMap_app_unique(1)[OF assms(1) that ua_η_a ua_η_b]
show ?thesis
by (cs_concl cs_simp: adj_cs_simps)
qed
show "?𝔉⦇ArrMap⦈⦇g ∘⇩A⇘ℭ⇙ f⦈ = ?𝔉⦇ArrMap⦈⦇g⦈ ∘⇩A⇘𝔇⇙ ?𝔉⦇ArrMap⦈⦇f⦈"
if "g : b ↦⇘ℭ⇙ c" and "f : a ↦⇘ℭ⇙ b" for b c g a f
proof-
from that have a: "a ∈⇩∘ ℭ⦇Obj⦈" and b: "b ∈⇩∘ ℭ⦇Obj⦈" and c: "c ∈⇩∘ ℭ⦇Obj⦈"
by (simp_all add: cat_cs_intros)
from assms(1) that have gf: "g ∘⇩A⇘ℭ⇙ f : a ↦⇘ℭ⇙ c"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
note ua_η_a = assms(3)[OF a]
and ua_η_b = assms(3)[OF b]
and ua_η_c = assms(3)[OF c]
note lara_f =
cf_la_of_ra_ArrMap_app_unique[OF assms(1) that(2) ua_η_a ua_η_b]
note lara_g =
cf_la_of_ra_ArrMap_app_unique[OF assms(1) that(1) ua_η_b ua_η_c]
note lara_gf =
cf_la_of_ra_ArrMap_app_unique[OF assms(1) gf ua_η_a ua_η_c]
note ua_η_a = 𝔊.universal_arrow_ofD[OF ua_η_a]
and ua_η_b = 𝔊.universal_arrow_ofD[OF ua_η_b]
and ua_η_c = 𝔊.universal_arrow_ofD[OF ua_η_c]
from ua_η_a(2) assms(1) that have ηa:
"η⦇NTMap⦈⦇a⦈ : a ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇F a⦈"
by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
from ua_η_b(2) assms(1) that have ηb:
"η⦇NTMap⦈⦇b⦈ : b ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇F b⦈"
by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
from ua_η_c(2) assms(1) that have ηc:
"η⦇NTMap⦈⦇c⦈ : c ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇F c⦈"
by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
from assms(1) that ηc have
"η⦇NTMap⦈⦇c⦈ ∘⇩A⇘ℭ⇙ (g ∘⇩A⇘ℭ⇙ f) = (η⦇NTMap⦈⦇c⦈ ∘⇩A⇘ℭ⇙ g) ∘⇩A⇘ℭ⇙ f"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
also from assms(1) lara_g(1) that(2) ηb have "… =
𝔊⦇ArrMap⦈⦇?𝔉⦇ArrMap⦈⦇g⦈⦈ ∘⇩A⇘ℭ⇙ (η⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ f)"
by
(
cs_concl
cs_simp: lara_g(2) cat_cs_simps
cs_intro: cat_cs_intros cat_prod_cs_intros
)
also from assms(1) lara_f(1) ηa have "… =
𝔊⦇ArrMap⦈⦇?𝔉⦇ArrMap⦈⦇g⦈⦈ ∘⇩A⇘ℭ⇙
(𝔊⦇ArrMap⦈⦇?𝔉⦇ArrMap⦈⦇f⦈⦈ ∘⇩A⇘ℭ⇙ η⦇NTMap⦈⦇a⦈)"
by (cs_concl cs_simp: lara_f(2) cat_cs_simps)
finally have [symmetric, cat_cs_simps]:
"η⦇NTMap⦈⦇c⦈ ∘⇩A⇘ℭ⇙ (g ∘⇩A⇘ℭ⇙ f) = …".
from assms(1) this ηa ηb ηc lara_g(1) lara_f(1) have
"η⦇NTMap⦈⦇c⦈ ∘⇩A⇘ℭ⇙ (g ∘⇩A⇘ℭ⇙ f) =
umap_of 𝔊 a (F a) (η⦇NTMap⦈⦇a⦈) (F c)⦇ArrVal⦈⦇?𝔉⦇ArrMap⦈⦇g⦈ ∘⇩A⇘𝔇⇙
?𝔉⦇ArrMap⦈⦇f⦈⦈"
by
(
cs_concl
cs_simp: adj_cs_simps cat_cs_simps
cs_intro: adj_cs_intros cat_cs_intros
)
moreover from assms(1) lara_g(1) lara_f(1) have
"?𝔉⦇ArrMap⦈⦇g⦈ ∘⇩A⇘𝔇⇙ ?𝔉⦇ArrMap⦈⦇f⦈ : F a ↦⇘𝔇⇙ F c"
by (cs_concl cs_intro: adj_cs_intros cat_cs_intros)
ultimately show ?thesis by (intro lara_gf(3))
qed
show "?𝔉⦇ArrMap⦈⦇ℭ⦇CId⦈⦇c⦈⦈ = 𝔇⦇CId⦈⦇?𝔉⦇ObjMap⦈⦇c⦈⦈" if "c ∈⇩∘ ℭ⦇Obj⦈" for c
proof-
note lara_c = cf_la_of_ra_ArrMap_app_unique[
OF
assms(1)
𝔊.HomCod.cat_CId_is_arr[OF that]
assms(3)[OF that]
assms(3)[OF that]
]
from assms(1) that have 𝔇c: "𝔇⦇CId⦈⦇F c⦈ : F c ↦⇘𝔇⇙ F c "
by (cs_concl cs_simp: cat_cs_simps cs_intro: assms(2) cat_cs_intros)
from 𝔊.universal_arrow_ofD(2)[OF assms(3)[OF that]] assms(1) that have ηc:
"η⦇NTMap⦈⦇c⦈ : c ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇F c⦈"
by (cs_prems cs_simp: adj_cs_simps cs_intro: cat_cs_intros)
from assms(1) that ηc have
"η⦇NTMap⦈⦇c⦈ ∘⇩A⇘ℭ⇙ ℭ⦇CId⦈⦇c⦈ =
umap_of 𝔊 c (F c) (η⦇NTMap⦈⦇c⦈) (F c)⦇ArrVal⦈⦇𝔇⦇CId⦈⦇F c⦈⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: assms(2) cat_cs_intros)
note [cat_cs_simps] = lara_c(3)[OF 𝔇c this]
from assms(1) that 𝔇c show ?thesis
by (cs_concl cs_simp: adj_cs_simps cat_cs_simps cs_intro: cat_cs_intros)
qed
qed (auto simp: cf_la_of_ra_components cat_cs_intros cat_cs_simps)
qed
lemma cf_la_of_ra_is_ntcf:
fixes F 𝔊 η
defines "𝔉 ≡ cf_la_of_ra F 𝔊 η"
assumes "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "⋀c. c ∈⇩∘ ℭ⦇Obj⦈ ⟹ F c ∈⇩∘ 𝔇⦇Obj⦈"
and "⋀c. c ∈⇩∘ ℭ⦇Obj⦈ ⟹
universal_arrow_of 𝔊 c (𝔉⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈)"
and "⋀c c' h. h : c ↦⇘ℭ⇙ c' ⟹
𝔊⦇ArrMap⦈⦇𝔉⦇ArrMap⦈⦇h⦈⦈ ∘⇩A⇘ℭ⇙ (η⦇NTMap⦈⦇c⦈) = (η⦇NTMap⦈⦇c'⦈) ∘⇩A⇘ℭ⇙ h"
and "vfsequence η"
and "vcard η = 5⇩ℕ"
and "η⦇NTDom⦈ = cf_id ℭ"
and "η⦇NTCod⦈ = 𝔊 ∘⇩C⇩F 𝔉"
and "η⦇NTDGDom⦈ = ℭ"
and "η⦇NTDGCod⦈ = ℭ"
and "vsv (η⦇NTMap⦈)"
and "𝒟⇩∘ (η⦇NTMap⦈) = ℭ⦇Obj⦈"
shows "η : cf_id ℭ ↦⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
proof-
interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(2))
have 𝔉: "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
unfolding 𝔉_def
by (auto intro: cf_la_of_ra_is_functor[OF assms(2-5)[unfolded assms(1)]])
show "η : cf_id ℭ ↦⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
proof(rule is_ntcfI')
from assms(2) show "cf_id ℭ : ℭ ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(2) 𝔉 show "𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "η⦇NTMap⦈⦇a⦈ : cf_id ℭ⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ (𝔊 ∘⇩C⇩F 𝔉)⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ ℭ⦇Obj⦈" for a
using assms(2) 𝔉 that 𝔊.universal_arrow_ofD(2)[OF assms(4)[OF that]]
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show
"η⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ cf_id ℭ⦇ArrMap⦈⦇f⦈ =
(𝔊 ∘⇩C⇩F 𝔉)⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ η⦇NTMap⦈⦇a⦈"
if "f : a ↦⇘ℭ⇙ b" for a b f
using assms(2) 𝔉 that
by (cs_concl cs_simp: assms(5) cat_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: assms(6-13))
qed
lemma cf_la_of_ra_is_unit:
fixes F 𝔊 η
defines "𝔉 ≡ cf_la_of_ra F 𝔊 η"
assumes "category α ℭ"
and "category α 𝔇"
and "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "⋀c. c ∈⇩∘ ℭ⦇Obj⦈ ⟹ F c ∈⇩∘ 𝔇⦇Obj⦈"
and "⋀c. c ∈⇩∘ ℭ⦇Obj⦈ ⟹
universal_arrow_of 𝔊 c (𝔉⦇ObjMap⦈⦇c⦈) (η⦇NTMap⦈⦇c⦈)"
and "⋀c c' h. h : c ↦⇘ℭ⇙ c' ⟹
𝔊⦇ArrMap⦈⦇𝔉⦇ArrMap⦈⦇h⦈⦈ ∘⇩A⇘ℭ⇙ (η⦇NTMap⦈⦇c⦈) = (η⦇NTMap⦈⦇c'⦈) ∘⇩A⇘ℭ⇙ h"
and "vfsequence η"
and "vcard η = 5⇩ℕ"
and "η⦇NTDom⦈ = cf_id ℭ"
and "η⦇NTCod⦈ = 𝔊 ∘⇩C⇩F 𝔉"
and "η⦇NTDGDom⦈ = ℭ"
and "η⦇NTDGCod⦈ = ℭ"
and "vsv (η⦇NTMap⦈)"
and "𝒟⇩∘ (η⦇NTMap⦈) = ℭ⦇Obj⦈"
shows "cf_adjunction_of_unit α 𝔉 𝔊 η : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "η⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η) = η"
proof-
note 𝔉 = cf_la_of_ra_is_functor[
where F=F and η=η, OF assms(4-7)[unfolded 𝔉_def], simplified
]
note η = cf_la_of_ra_is_ntcf[OF assms(4-15)[unfolded 𝔉_def], simplified]
show "cf_adjunction_of_unit α 𝔉 𝔊 η : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "η⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η) = η"
by
(
intro
cf_adjunction_of_unit_is_cf_adjunction
[
OF assms(2,3) 𝔉 assms(4) η assms(6)[unfolded 𝔉_def],
simplified,
folded 𝔉_def
]
)+
qed
subsection‹
Construction of an adjunction from universal morphisms
from functors to objects
›
subsubsection‹Definition and elementary properties›
text‹
The subsection presents the construction of an adjunction given
a structured collection of universal morphisms from functors to objects.
The content of this subsection follows the statement and the proof
of Theorem 2-iii in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›
definition cf_adjunction_of_counit :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
where "cf_adjunction_of_counit α 𝔉 𝔊 ε =
op_cf_adj (cf_adjunction_of_unit α (op_cf 𝔊) (op_cf 𝔉) (op_ntcf ε))"
text‹Components.›
lemma cf_adjunction_of_counit_components:
shows "cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjLeft⦈ = op_cf (op_cf 𝔉)"
and "cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjRight⦈ = op_cf (op_cf 𝔊)"
and "cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈ = op_cf_adj_nt
(op_cf 𝔊⦇HomDom⦈)
(op_cf 𝔊⦇HomCod⦈)
(cf_adjunction_AdjNT_of_unit α (op_cf 𝔊) (op_cf 𝔉) (op_ntcf ε))"
unfolding
cf_adjunction_of_counit_def
op_cf_adj_components
cf_adjunction_of_unit_components
by (simp_all add: cat_op_simps)
subsubsection‹Natural transformation map›
lemma cf_adjunction_of_counit_NTMap_vsv:
"vsv (cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈⦇NTMap⦈)"
unfolding cf_adjunction_of_counit_components by (rule inv_ntcf_NTMap_vsv)
subsubsection‹
An adjunction constructed from universal morphisms
from functors to objects is an adjunction
›
lemma cf_adjunction_of_counit_is_cf_adjunction:
assumes "category α ℭ"
and "category α 𝔇"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "ε : 𝔉 ∘⇩C⇩F 𝔊 ↦⇩C⇩F cf_id 𝔇 : 𝔇 ↦↦⇩C⇘α⇙ 𝔇"
and "⋀x. x ∈⇩∘ 𝔇⦇Obj⦈ ⟹ universal_arrow_fo 𝔉 x (𝔊⦇ObjMap⦈⦇x⦈) (ε⦇NTMap⦈⦇x⦈)"
shows "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "ε⇩C (cf_adjunction_of_counit α 𝔉 𝔊 ε) = ε"
and "𝒟⇩∘ (cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈⦇NTMap⦈) =
(op_cat ℭ ×⇩C 𝔇)⦇Obj⦈"
and "⋀c d. ⟦ c ∈⇩∘ ℭ⦇Obj⦈; d ∈⇩∘ 𝔇⦇Obj⦈ ⟧ ⟹
cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈⦇NTMap⦈⦇c, d⦈⇩∙ =
(umap_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈) c)¯⇩S⇩e⇩t"
proof-
interpret ℭ: category α ℭ by (rule assms(1))
interpret 𝔇: category α 𝔇 by (rule assms(2))
interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(3))
interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(4))
interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘⇩C⇩F 𝔊› ‹cf_id 𝔇› ε by (rule assms(5))
note cf_adjunction_of_counit_def' =
cf_adjunction_of_counit_def[where 𝔉=𝔉, unfolded 𝔉.cf_HomDom 𝔉.cf_HomCod]
have ua:
"universal_arrow_of (op_cf 𝔉) x (op_cf 𝔊⦇ObjMap⦈⦇x⦈) (op_ntcf ε⦇NTMap⦈⦇x⦈)"
if "x ∈⇩∘ op_cat 𝔇⦇Obj⦈" for x
using that unfolding cat_op_simps by (rule assms(6))
let ?aou = ‹cf_adjunction_of_unit α (op_cf 𝔊) (op_cf 𝔉) (op_ntcf ε)›
from
cf_adjunction_of_unit_is_cf_adjunction
[
OF
𝔇.category_op
ℭ.category_op
𝔊.is_functor_op
𝔉.is_functor_op
ε.is_ntcf_op[unfolded cat_op_simps]
ua,
simplified cf_adjunction_of_counit_def[symmetric]
]
have aou: "?aou : op_cf 𝔊 ⇌⇩C⇩F op_cf 𝔉 : op_cat 𝔇 ⇌⇌⇩C⇘α⇙ op_cat ℭ"
and η_aou: "η⇩C ?aou = op_ntcf ε"
by auto
interpret aou:
is_cf_adjunction α ‹op_cat 𝔇› ‹op_cat ℭ› ‹op_cf 𝔊› ‹op_cf 𝔉› ?aou
by (rule aou)
from η_aou have
"op_ntcf (η⇩C ?aou) = op_ntcf (op_ntcf ε)"
by simp
then show "ε⇩C (cf_adjunction_of_counit α 𝔉 𝔊 ε) = ε"
unfolding
ε.ntcf_op_ntcf_op_ntcf
is_cf_adjunction.op_ntcf_cf_adjunction_unit[OF aou]
cf_adjunction_of_counit_def'[symmetric]
by (simp add: cat_op_simps)
show aoc_ε: "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
by
(
rule
is_cf_adjunction_op[
OF aou, folded cf_adjunction_of_counit_def', unfolded cat_op_simps
]
)
interpret aoc_ε: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 ‹cf_adjunction_of_counit α 𝔉 𝔊 ε›
by (rule aoc_ε)
from aoc_ε.NT.is_ntcf_axioms show
"𝒟⇩∘ (cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈⦇NTMap⦈) = (op_cat ℭ ×⇩C 𝔇)⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
show "⋀c d. ⟦ c ∈⇩∘ ℭ⦇Obj⦈; d ∈⇩∘ 𝔇⦇Obj⦈ ⟧ ⟹
cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈⦇NTMap⦈⦇c, d⦈⇩∙ =
(umap_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈) c)¯⇩S⇩e⇩t"
proof-
fix c d assume prems: "c ∈⇩∘ ℭ⦇Obj⦈" "d ∈⇩∘ 𝔇⦇Obj⦈"
from assms(1-4) prems have aou_dc:
"cf_adjunction_AdjNT_of_unit
α (op_cf 𝔊) (op_cf 𝔉) (op_ntcf ε)⦇NTMap⦈⦇d, c⦈⇩∙ =
umap_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈) c"
by (cs_concl cs_simp: cat_op_simps adj_cs_simps cs_intro: cat_op_intros)
from assms(1-4) aou prems have ufo_ε_dc:
"umap_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈) c :
Hom⇩O⇩.⇩C⇘α⇙op_cat ℭ(op_cf 𝔊-,-)⦇ObjMap⦈⦇d, c⦈⇩∙ ↦⇩i⇩s⇩o⇘cat_Set α⇙
Hom⇩O⇩.⇩C⇘α⇙op_cat 𝔇(-,op_cf 𝔉-)⦇ObjMap⦈⦇d, c⦈⇩∙"
by
(
cs_concl
cs_simp:
aou_dc[symmetric] cf_adjunction_of_unit_components(3)[symmetric]
cs_intro:
is_iso_ntcf.iso_ntcf_is_arr_isomorphism'
adj_cs_intros
cat_cs_intros
cat_op_intros
cat_prod_cs_intros
)
from
assms(1-4)
aoc_ε[unfolded cf_adjunction_of_counit_def']
aou
prems
ufo_ε_dc
show
"cf_adjunction_of_counit α 𝔉 𝔊 ε⦇AdjNT⦈⦇NTMap⦈⦇c, d⦈⇩∙ =
(umap_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈) c)¯⇩S⇩e⇩t"
unfolding cf_adjunction_of_counit_def'
by
(
cs_concl
cs_simp: cat_op_simps adj_cs_simps cat_cs_simps cat_Set_cs_simps
cs_intro: adj_cs_intros cat_cs_intros cat_prod_cs_intros
)
qed
qed
subsection‹
Construction of an adjunction from a functor and universal morphisms
from functors to objects
›
text‹
The subsection presents the construction of an adjunction given
a functor and a structured collection of universal morphisms
from functors to objects.
The content of this subsection follows the statement and the proof
of Theorem 2-iv in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›
subsubsection‹Definition and elementary properties›
definition cf_ra_of_la :: "(V ⇒ V) ⇒ V ⇒ V ⇒ V"
where "cf_ra_of_la F 𝔉 ε = op_cf (cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε))"
subsubsection‹Object map›
lemma cf_ra_of_la_ObjMap_vsv[adj_cs_intros]: "vsv (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈)"
unfolding cf_ra_of_la_def op_cf_components by (auto intro: adj_cs_intros)
lemma (in is_functor) cf_ra_of_la_ObjMap_vdomain:
"𝒟⇩∘ (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈) = 𝔅⦇Obj⦈"
unfolding cf_ra_of_la_def cf_la_of_ra_components cat_op_simps
by (simp add: cat_cs_simps)
lemmas [adj_cs_simps] = is_functor.cf_ra_of_la_ObjMap_vdomain
lemma (in is_functor) cf_ra_of_la_ObjMap_app:
assumes "d ∈⇩∘ 𝔅⦇Obj⦈"
shows "cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇d⦈ = F d"
using assms
unfolding cf_ra_of_la_def cf_la_of_ra_components cat_op_simps
by (simp add: cat_cs_simps)
lemmas [adj_cs_simps] = is_functor.cf_ra_of_la_ObjMap_app
subsubsection‹Arrow map›
lemma cf_ra_of_la_ArrMap_app_unique:
assumes "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "f : a ↦⇘𝔇⇙ b"
and "universal_arrow_fo 𝔉 a (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇a⦈) (ε⦇NTMap⦈⦇a⦈)"
and "universal_arrow_fo 𝔉 b (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇b⦈) (ε⦇NTMap⦈⦇b⦈)"
shows "cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈ : F a ↦⇘ℭ⇙ F b"
and "f ∘⇩A⇘𝔇⇙ ε⦇NTMap⦈⦇a⦈ =
umap_fo 𝔉 b (F b) (ε⦇NTMap⦈⦇b⦈) (F a)⦇ArrVal⦈⦇cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈⦈"
and "⋀f'.
⟦
f' : F a ↦⇘ℭ⇙ F b;
f ∘⇩A⇘𝔇⇙ ε⦇NTMap⦈⦇a⦈ = umap_fo 𝔉 b (F b) (ε⦇NTMap⦈⦇b⦈) (F a)⦇ArrVal⦈⦇f'⦈
⟧ ⟹ cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈ = f'"
proof-
interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(1))
from assms(2) have op_f: "f : b ↦⇘op_cat 𝔇⇙ a" unfolding cat_op_simps by simp
let ?lara = ‹cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε)›
have lara_ObjMap_eq_op: "?lara⦇ObjMap⦈ = (op_cf ?lara⦇ObjMap⦈)"
and lara_ArrMap_eq_op: "?lara⦇ArrMap⦈ = (op_cf ?lara⦇ArrMap⦈)"
unfolding cat_op_simps by simp_all
note ua_η_a = 𝔉.universal_arrow_foD[OF assms(3)]
and ua_η_b = 𝔉.universal_arrow_foD[OF assms(4)]
from assms(1,2) ua_η_a(2) have [cat_op_simps]:
"ε⦇NTMap⦈⦇a⦈ ∘⇩A⇘op_cat 𝔇⇙ f = f ∘⇩A⇘𝔇⇙ ε⦇NTMap⦈⦇a⦈"
by (cs_concl cs_simp: cat_cs_simps cat_op_simps)
show "cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈ : F a ↦⇘ℭ⇙ F b"
and "f ∘⇩A⇘𝔇⇙ ε⦇NTMap⦈⦇a⦈ =
umap_fo 𝔉 b (F b) (ε⦇NTMap⦈⦇b⦈) (F a)⦇ArrVal⦈⦇cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈⦈"
and "⋀f'.
⟦
f' : F a ↦⇘ℭ⇙ F b;
f ∘⇩A⇘𝔇⇙ ε⦇NTMap⦈⦇a⦈ = umap_fo 𝔉 b (F b) (ε⦇NTMap⦈⦇b⦈) (F a)⦇ArrVal⦈⦇f'⦈
⟧ ⟹ cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈ = f'"
by
(
intro
cf_la_of_ra_ArrMap_app_unique
[
where η=‹op_ntcf ε› and F=F,
OF 𝔉.is_functor_op op_f,
unfolded
𝔉.op_cf_universal_arrow_of
lara_ObjMap_eq_op
lara_ArrMap_eq_op,
folded cf_ra_of_la_def,
unfolded cat_op_simps,
OF assms(4,3)
]
)+
qed
lemma cf_ra_of_la_ArrMap_app_is_arr[adj_cs_intros]:
assumes "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "f : a ↦⇘𝔇⇙ b"
and "universal_arrow_fo 𝔉 a (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇a⦈) (ε⦇NTMap⦈⦇a⦈)"
and "universal_arrow_fo 𝔉 b (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇b⦈) (ε⦇NTMap⦈⦇b⦈)"
and "Fa = F a"
and "Fb = F b"
shows "cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇f⦈ : Fa ↦⇘ℭ⇙ Fb"
using assms(1-4) unfolding assms(5,6) by (rule cf_ra_of_la_ArrMap_app_unique)
subsubsection‹
An adjunction constructed from a functor and universal morphisms
from functors to objects is an adjunction
›
lemma op_cf_cf_la_of_ra_op[cat_op_simps]:
"op_cf (cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε)) = cf_ra_of_la F 𝔉 ε"
unfolding cf_ra_of_la_def by simp
lemma cf_ra_of_la_commute_op:
assumes "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "⋀d. d ∈⇩∘ 𝔇⦇Obj⦈ ⟹
universal_arrow_fo 𝔉 d (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈)"
and "⋀d d' h. h : d ↦⇘𝔇⇙ d' ⟹
ε⦇NTMap⦈⦇d'⦈ ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇h⦈⦈ =
h ∘⇩A⇘𝔇⇙ ε⦇NTMap⦈⦇d⦈"
and "h : c' ↦⇘𝔇⇙ c"
shows "𝔉⦇ArrMap⦈⦇cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇h⦈⦈ ∘⇩A⇘op_cat 𝔇⇙ ε⦇NTMap⦈⦇c⦈ =
ε⦇NTMap⦈⦇c'⦈ ∘⇩A⇘op_cat 𝔇⇙ h"
proof-
interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(1))
from assms(4) have c': "c' ∈⇩∘ 𝔇⦇Obj⦈" and c: "c ∈⇩∘ 𝔇⦇Obj⦈" by auto
note ua_η_c' = 𝔉.universal_arrow_foD[OF assms(2)[OF c']]
and ua_η_c = 𝔉.universal_arrow_foD[OF assms(2)[OF c]]
note rala_f = cf_ra_of_la_ArrMap_app_unique[
OF assms(1) assms(4) assms(2)[OF c'] assms(2)[OF c]
]
from assms(1) assms(4) ua_η_c'(2) ua_η_c(2) rala_f(1) show ?thesis
by
(
cs_concl
cs_simp: assms(3) cat_op_simps adj_cs_simps cat_cs_simps
cs_intro: cat_cs_intros
)
qed
lemma
assumes "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "⋀d. d ∈⇩∘ 𝔇⦇Obj⦈ ⟹ F d ∈⇩∘ ℭ⦇Obj⦈"
and "⋀d. d ∈⇩∘ 𝔇⦇Obj⦈ ⟹
universal_arrow_fo 𝔉 d (cf_ra_of_la F 𝔉 ε⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈)"
and "⋀d d' h. h : d ↦⇘𝔇⇙ d' ⟹
ε⦇NTMap⦈⦇d'⦈ ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇h⦈⦈ =
h ∘⇩A⇘𝔇⇙ ε⦇NTMap⦈⦇d⦈"
shows cf_ra_of_la_is_functor: "cf_ra_of_la F 𝔉 ε : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and cf_la_of_ra_op_is_functor:
"cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε) : op_cat 𝔇 ↦↦⇩C⇘α⇙ op_cat ℭ"
proof-
interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(1))
have 𝔉h_εc:
"𝔉⦇ArrMap⦈⦇cf_ra_of_la F 𝔉 ε⦇ArrMap⦈⦇h⦈⦈ ∘⇩A⇘op_cat 𝔇⇙ ε⦇NTMap⦈⦇c⦈ =
ε⦇NTMap⦈⦇c'⦈ ∘⇩A⇘op_cat 𝔇⇙ h"
if "h : c' ↦⇘𝔇⇙ c" for c c' h
proof-
from that have c': "c' ∈⇩∘ 𝔇⦇Obj⦈" and c: "c ∈⇩∘ 𝔇⦇Obj⦈" by auto
note ua_η_c' = 𝔉.universal_arrow_foD[OF assms(3)[OF c']]
and ua_η_c = 𝔉.universal_arrow_foD[OF assms(3)[OF c]]
note rala_f = cf_ra_of_la_ArrMap_app_unique[
OF assms(1) that assms(3)[OF c'] assms(3)[OF c]
]
from assms(1) that ua_η_c'(2) ua_η_c(2) rala_f(1) show ?thesis
by
(
cs_concl
cs_simp: assms(4) cat_op_simps adj_cs_simps cat_cs_simps
cs_intro: cat_cs_intros
)
qed
let ?lara = ‹cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε)›
have lara_ObjMap_eq_op: "?lara⦇ObjMap⦈ = (op_cf ?lara⦇ObjMap⦈)"
and lara_ArrMap_eq_op: "?lara⦇ArrMap⦈ = (op_cf ?lara⦇ArrMap⦈)"
by (simp_all add: cat_op_simps del: op_cf_cf_la_of_ra_op)
show "cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε) : op_cat 𝔇 ↦↦⇩C⇘α⇙ op_cat ℭ"
by
(
intro cf_la_of_ra_is_functor
[
where F=F and η=‹op_ntcf ε›,
OF 𝔉.is_functor_op,
unfolded cat_op_simps,
OF assms(2),
simplified,
unfolded lara_ObjMap_eq_op lara_ArrMap_eq_op,
folded cf_ra_of_la_def,
OF assms(3) 𝔉h_εc
]
)
from
is_functor.is_functor_op[
OF this, unfolded cat_op_simps, folded cf_ra_of_la_def
]
show "cf_ra_of_la F 𝔉 ε : 𝔇 ↦↦⇩C⇘α⇙ ℭ".
qed
lemma cf_ra_of_la_is_ntcf:
fixes F 𝔉 ε
defines "𝔊 ≡ cf_ra_of_la F 𝔉 ε"
assumes "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "⋀d. d ∈⇩∘ 𝔇⦇Obj⦈ ⟹ F d ∈⇩∘ ℭ⦇Obj⦈"
and "⋀d. d ∈⇩∘ 𝔇⦇Obj⦈ ⟹
universal_arrow_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈)"
and "⋀d d' h. h : d ↦⇘𝔇⇙ d' ⟹
ε⦇NTMap⦈⦇d'⦈ ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇𝔊⦇ArrMap⦈⦇h⦈⦈ = h ∘⇩A⇘𝔇⇙ ε⦇NTMap⦈⦇d⦈"
and "vfsequence ε"
and "vcard ε = 5⇩ℕ"
and "ε⦇NTDom⦈ = 𝔉 ∘⇩C⇩F 𝔊"
and "ε⦇NTCod⦈ = cf_id 𝔇"
and "ε⦇NTDGDom⦈ = 𝔇"
and "ε⦇NTDGCod⦈ = 𝔇"
and "vsv (ε⦇NTMap⦈)"
and "𝒟⇩∘ (ε⦇NTMap⦈) = 𝔇⦇Obj⦈"
shows "ε : 𝔉 ∘⇩C⇩F 𝔊 ↦⇩C⇩F cf_id 𝔇 : 𝔇 ↦↦⇩C⇘α⇙ 𝔇"
proof-
interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(2))
interpret 𝔊: is_functor α 𝔇 ℭ 𝔊
unfolding 𝔊_def
by (auto intro: cf_ra_of_la_is_functor[OF assms(2-5)[unfolded assms(1)]])
interpret op_ε: is_functor
α ‹op_cat 𝔇› ‹op_cat ℭ› ‹cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε)›
by
(
intro cf_la_of_ra_op_is_functor[
where F=F and ε=ε, OF assms(2,3,4,5)[unfolded 𝔊_def], simplified
]
)
interpret ε: vfsequence ε by (rule assms(6))
have [cat_op_simps]: "op_ntcf (op_ntcf ε) = ε"
proof(rule vsv_eqI)
have dom_lhs: "𝒟⇩∘ (op_ntcf (op_ntcf ε)) = 5⇩ℕ"
unfolding op_ntcf_def by (simp add: nat_omega_simps)
from assms(7) show "𝒟⇩∘ (op_ntcf (op_ntcf ε)) = 𝒟⇩∘ ε"
by (simp add: dom_lhs ε.vfsequence_vdomain)
have sup:
"op_ntcf (op_ntcf ε)⦇NTDom⦈ = ε⦇NTDom⦈"
"op_ntcf (op_ntcf ε)⦇NTCod⦈ = ε⦇NTCod⦈"
"op_ntcf (op_ntcf ε)⦇NTDGDom⦈ = ε⦇NTDGDom⦈"
"op_ntcf (op_ntcf ε)⦇NTDGCod⦈ = ε⦇NTDGCod⦈"
unfolding op_ntcf_components assms(8-11) cat_op_simps
by simp_all
show "a ∈⇩∘ 𝒟⇩∘ (op_ntcf (op_ntcf ε)) ⟹ op_ntcf (op_ntcf ε)⦇a⦈ = ε⦇a⦈" for a
by (unfold dom_lhs, elim_in_numeral, fold nt_field_simps, unfold sup)
(simp_all add: cat_op_simps)
qed (auto simp: op_ntcf_def)
let ?lara = ‹cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε)›
have lara_ObjMap_eq_op: "?lara⦇ObjMap⦈ = (op_cf ?lara⦇ObjMap⦈)"
and lara_ArrMap_eq_op: "?lara⦇ArrMap⦈ = (op_cf ?lara⦇ArrMap⦈)"
by (simp_all add: cat_op_simps del: op_cf_cf_la_of_ra_op)
have seq: "vfsequence (op_ntcf ε)" unfolding op_ntcf_def by auto
have card: "vcard (op_ntcf ε) = 5⇩ℕ"
unfolding op_ntcf_def by (simp add: nat_omega_simps)
have op_cf_NTCod: "op_cf (ε⦇NTCod⦈) = cf_id (op_cat 𝔇)"
unfolding assms(9) cat_op_simps by simp
from assms(2) have op_cf_NTDom:
"op_cf (ε⦇NTDom⦈) = op_cf 𝔉 ∘⇩C⇩F cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε)"
unfolding assms(8) cat_op_simps 𝔊_def
by (simp_all add: cat_op_simps cf_ra_of_la_def del: op_cf_cf_la_of_ra_op)
have "op_ntcf ε :
cf_id (op_cat 𝔇) ↦⇩C⇩F op_cf 𝔉 ∘⇩C⇩F cf_la_of_ra F (op_cf 𝔉) (op_ntcf ε) :
op_cat 𝔇 ↦↦⇩C⇘α⇙ op_cat 𝔇"
by
(
auto intro: cf_la_of_ra_is_ntcf
[
where F=F and η=‹op_ntcf ε›,
OF is_functor.is_functor_op[OF assms(2)],
unfolded cat_op_simps,
OF assms(3),
simplified,
unfolded
lara_ObjMap_eq_op
lara_ArrMap_eq_op
cf_ra_of_la_def[symmetric],
OF assms(4)[unfolded 𝔊_def],
simplified,
OF cf_ra_of_la_commute_op[
OF assms(2,4,5)[unfolded 𝔊_def], simplified
],
simplified,
OF seq card _ op_cf_NTDom _ _ assms(12),
unfolded assms(8-11,13) cat_op_simps
]
)
from is_ntcf.is_ntcf_op[OF this, unfolded cat_op_simps 𝔊_def[symmetric]] show
"ε : 𝔉 ∘⇩C⇩F 𝔊 ↦⇩C⇩F cf_id 𝔇 : 𝔇 ↦↦⇩C⇘α⇙ 𝔇".
qed
lemma cf_ra_of_la_is_counit:
fixes F 𝔉 ε
defines "𝔊 ≡ cf_ra_of_la F 𝔉 ε"
assumes "category α ℭ"
and "category α 𝔇"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "⋀d. d ∈⇩∘ 𝔇⦇Obj⦈ ⟹ F d ∈⇩∘ ℭ⦇Obj⦈"
and "⋀d. d ∈⇩∘ 𝔇⦇Obj⦈ ⟹
universal_arrow_fo 𝔉 d (𝔊⦇ObjMap⦈⦇d⦈) (ε⦇NTMap⦈⦇d⦈)"
and "⋀d d' h. h : d ↦⇘𝔇⇙ d' ⟹
ε⦇NTMap⦈⦇d'⦈ ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇𝔊⦇ArrMap⦈⦇h⦈⦈ = h ∘⇩A⇘𝔇⇙ ε⦇NTMap⦈⦇d⦈"
and "vfsequence ε"
and "vcard ε = 5⇩ℕ"
and "ε⦇NTDom⦈ = 𝔉 ∘⇩C⇩F 𝔊"
and "ε⦇NTCod⦈ = cf_id 𝔇"
and "ε⦇NTDGDom⦈ = 𝔇"
and "ε⦇NTDGCod⦈ = 𝔇"
and "vsv (ε⦇NTMap⦈)"
and "𝒟⇩∘ (ε⦇NTMap⦈) = 𝔇⦇Obj⦈"
shows "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "ε⇩C (cf_adjunction_of_counit α 𝔉 𝔊 ε) = ε"
proof-
note 𝔉 = cf_ra_of_la_is_functor[
where F=F and ε=ε, OF assms(4-7)[unfolded 𝔊_def], simplified
]
note ε = cf_ra_of_la_is_ntcf[OF assms(4-15)[unfolded 𝔊_def], simplified]
show "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "ε⇩C (cf_adjunction_of_counit α 𝔉 𝔊 ε) = ε"
by
(
intro
cf_adjunction_of_counit_is_cf_adjunction
[
OF assms(2,3,4) 𝔉 ε assms(6)[unfolded 𝔊_def],
simplified,
folded 𝔊_def
]
)+
qed
subsection‹Construction of an adjunction from the counit-unit equations›
text‹
The subsection presents the construction of an adjunction given
two natural transformations satisfying counit-unit equations.
The content of this subsection follows the statement and the proof
of Theorem 2-v in Chapter IV-1 in \cite{mac_lane_categories_2010}.
›
lemma counit_unit_is_cf_adjunction:
assumes "category α ℭ"
and "category α 𝔇"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "η : cf_id ℭ ↦⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
and "ε : 𝔉 ∘⇩C⇩F 𝔊 ↦⇩C⇩F cf_id 𝔇 : 𝔇 ↦↦⇩C⇘α⇙ 𝔇"
and "(𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ε) ∙⇩N⇩T⇩C⇩F (η ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊) = ntcf_id 𝔊"
and "(ε ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉) ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F η) = ntcf_id 𝔉"
shows "cf_adjunction_of_unit α 𝔉 𝔊 η : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "η⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η) = η"
and "ε⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η) = ε"
proof-
interpret ℭ: category α ℭ by (rule assms(1))
interpret 𝔇: category α 𝔇 by (rule assms(2))
interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(3))
interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(4))
interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘⇩C⇩F 𝔉› η by (rule assms(5))
interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘⇩C⇩F 𝔊› ‹cf_id 𝔇› ε by (rule assms(6))
have 𝔊εx_η𝔊x[cat_cs_simps]:
"𝔊⦇ArrMap⦈⦇ε⦇NTMap⦈⦇x⦈⦈ ∘⇩A⇘ℭ⇙ η⦇NTMap⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈ = ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈"
if "x ∈⇩∘ 𝔇⦇Obj⦈" for x
proof-
from assms(7) have
"((𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ε) ∙⇩N⇩T⇩C⇩F (η ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊))⦇NTMap⦈⦇x⦈ = ntcf_id 𝔊⦇NTMap⦈⦇x⦈"
by simp
from this assms(1-6) that show
"𝔊⦇ArrMap⦈⦇ε⦇NTMap⦈⦇x⦈⦈ ∘⇩A⇘ℭ⇙ η⦇NTMap⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈ =
ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
have [cat_cs_simps]:
"𝔊⦇ArrMap⦈⦇ε⦇NTMap⦈⦇x⦈⦈ ∘⇩A⇘ℭ⇙ (η⦇NTMap⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈ ∘⇩A⇘ℭ⇙ f) =
ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇x⦈⦈ ∘⇩A⇘ℭ⇙ f"
if "x ∈⇩∘ 𝔇⦇Obj⦈" and "f : a ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇x⦈" for x f a
using assms(1-6) that
by (intro ℭ.cat_assoc_helper)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
have [cat_cs_simps]:
"ε⦇NTMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈ ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇η⦇NTMap⦈⦇x⦈⦈ = 𝔇⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
if "x ∈⇩∘ ℭ⦇Obj⦈" for x
proof-
from assms(8) have
"((ε ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉) ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F η))⦇NTMap⦈⦇x⦈ = ntcf_id 𝔉⦇NTMap⦈⦇x⦈"
by simp
from this assms(1-6) that show
"ε⦇NTMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈ ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇η⦇NTMap⦈⦇x⦈⦈ = 𝔇⦇CId⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
have ua_𝔉x_ηx: "universal_arrow_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⦇NTMap⦈⦇x⦈)"
if "x ∈⇩∘ ℭ⦇Obj⦈" for x
proof(intro is_functor.universal_arrow_ofI)
from assms(3) that show "𝔉⦇ObjMap⦈⦇x⦈ ∈⇩∘ 𝔇⦇Obj⦈"
by (cs_concl cs_intro: cat_cs_intros)
from assms(3-6) that show "η⦇NTMap⦈⦇x⦈ : x ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
fix r' u' assume prems': "r' ∈⇩∘ 𝔇⦇Obj⦈" "u' : x ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇r'⦈"
show "∃!f'.
f' : 𝔉⦇ObjMap⦈⦇x⦈ ↦⇘𝔇⇙ r' ∧
u' = umap_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⦇NTMap⦈⦇x⦈) r'⦇ArrVal⦈⦇f'⦈"
proof(intro ex1I conjI; (elim conjE)?)
from assms(3-6) that prems' show
"ε⦇NTMap⦈⦇r'⦈ ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇u'⦈ : 𝔉⦇ObjMap⦈⦇x⦈ ↦⇘𝔇⇙ r'"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3-6) prems' have 𝔊𝔉u':
"(𝔊 ∘⇩C⇩F 𝔉)⦇ArrMap⦈⦇u'⦈ = 𝔊⦇ArrMap⦈⦇𝔉⦇ArrMap⦈⦇u'⦈⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
note [cat_cs_simps] =
η.ntcf_Comp_commute[symmetric, OF prems'(2), unfolded 𝔊𝔉u']
from assms(3-6) that prems' show
"u' =
umap_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⦇NTMap⦈⦇x⦈) r'⦇ArrVal⦈⦇ε⦇NTMap⦈⦇r'⦈ ∘⇩A⇘𝔇⇙
𝔉⦇ArrMap⦈⦇u'⦈⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
fix f' assume prems'':
"f' : 𝔉⦇ObjMap⦈⦇x⦈ ↦⇘𝔇⇙ r'"
"u' = umap_of 𝔊 x (𝔉⦇ObjMap⦈⦇x⦈) (η⦇NTMap⦈⦇x⦈) r'⦇ArrVal⦈⦇f'⦈"
from prems''(2,1) assms(3-6) that have u'_def:
"u' = 𝔊⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘ℭ⇙ η⦇NTMap⦈⦇x⦈"
by
(
cs_prems
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
from
ε.ntcf_Comp_commute[OF prems''(1)]
assms(3-6)
prems''(1)
have [cat_cs_simps]:
"ε⦇NTMap⦈⦇r'⦈ ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇𝔊⦇ArrMap⦈⦇f'⦈⦈ =
f' ∘⇩A⇘𝔇⇙ ε⦇NTMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have [cat_cs_simps]:
"ε⦇NTMap⦈⦇r'⦈ ∘⇩A⇘𝔇⇙ (𝔉⦇ArrMap⦈⦇𝔊⦇ArrMap⦈⦇f'⦈⦈ ∘⇩A⇘𝔇⇙ f) =
(f' ∘⇩A⇘𝔇⇙ ε⦇NTMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈) ∘⇩A⇘𝔇⇙ f"
if "f : a ↦⇘𝔇⇙ 𝔉⦇ObjMap⦈⦇𝔊⦇ObjMap⦈⦇𝔉⦇ObjMap⦈⦇x⦈⦈⦈" for f a
using assms(1-6) prems''(1) prems' that
by (intro 𝔇.cat_assoc_helper)
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)+
from prems''(2,1) assms(3-6) that show
"f' = ε⦇NTMap⦈⦇r'⦈ ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇u'⦈"
unfolding u'_def
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_prod_cs_intros
)
qed
qed (auto intro: cat_cs_intros)
show aou: "cf_adjunction_of_unit α 𝔉 𝔊 η : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
by (intro cf_adjunction_of_unit_is_cf_adjunction ua_𝔉x_ηx assms(1-5))
from ℭ.category_axioms 𝔇.category_axioms show "η⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η) = η"
by (cs_concl cs_intro: cf_adjunction_of_unit_is_cf_adjunction assms(1-5) ua_𝔉x_ηx)
interpret aou: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 ‹cf_adjunction_of_unit α 𝔉 𝔊 η›
by (rule aou)
show "ε⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η) = ε"
proof(rule ntcf_eqI)
show ε_η: "ε⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η) :
𝔉 ∘⇩C⇩F 𝔊 ↦⇩C⇩F cf_id 𝔇 : 𝔇 ↦↦⇩C⇘α⇙ 𝔇"
by (rule aou.cf_adjunction_counit_is_ntcf)
from assms(1-6) ε_η have dom_lhs:
"𝒟⇩∘ (ε⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η)⦇NTMap⦈) = 𝔇⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
from assms(1-6) ε_η have dom_rhs: "𝒟⇩∘ (ε⦇NTMap⦈) = 𝔇⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
show "ε⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η)⦇NTMap⦈ = ε⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ∈⇩∘ 𝔇⦇Obj⦈"
with aou.is_cf_adjunction_axioms assms(1-6) show
"ε⇩C (cf_adjunction_of_unit α 𝔉 𝔊 η)⦇NTMap⦈⦇a⦈ = ε⦇NTMap⦈⦇a⦈"
by
(
cs_concl
cs_intro:
cat_arrow_cs_intros
cat_op_intros
cat_cs_intros
cat_prod_cs_intros
cs_simp:
aou.cf_adj_umap_of_unit'[symmetric]
cat_Set_the_inverse[symmetric]
adj_cs_simps cat_cs_simps cat_op_simps
)
qed (auto simp: adj_cs_intros)
qed (auto simp: assms)
qed
lemma counit_unit_cf_adjunction_of_counit_is_cf_adjunction:
assumes "category α ℭ"
and "category α 𝔇"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "η : cf_id ℭ ↦⇩C⇩F 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ ℭ"
and "ε : 𝔉 ∘⇩C⇩F 𝔊 ↦⇩C⇩F cf_id 𝔇 : 𝔇 ↦↦⇩C⇘α⇙ 𝔇"
and "(𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ε) ∙⇩N⇩T⇩C⇩F (η ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊) = ntcf_id 𝔊"
and "(ε ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉) ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F η) = ntcf_id 𝔉"
shows "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "η⇩C (cf_adjunction_of_counit α 𝔉 𝔊 ε) = η"
and "ε⇩C (cf_adjunction_of_counit α 𝔉 𝔊 ε) = ε"
proof-
interpret ℭ: category α ℭ by (rule assms(1))
interpret 𝔇: category α 𝔇 by (rule assms(2))
interpret 𝔉: is_functor α ℭ 𝔇 𝔉 by (rule assms(3))
interpret 𝔊: is_functor α 𝔇 ℭ 𝔊 by (rule assms(4))
interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘⇩C⇩F 𝔉› η by (rule assms(5))
interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘⇩C⇩F 𝔊› ‹cf_id 𝔇› ε by (rule assms(6))
have unit_op: "cf_adjunction_of_unit α (op_cf 𝔊) (op_cf 𝔉) (op_ntcf ε) :
op_cf 𝔊 ⇌⇩C⇩F op_cf 𝔉 : op_cat 𝔇 ⇌⇌⇩C⇘α⇙ op_cat ℭ"
by (rule counit_unit_is_cf_adjunction(1)[where ε=‹op_ntcf η›])
(
cs_concl
cs_simp:
cat_op_simps cat_cs_simps
𝔊.cf_ntcf_id_op_cf
𝔉.cf_ntcf_id_op_cf
op_ntcf_ntcf_vcomp[symmetric]
op_ntcf_ntcf_cf_comp[symmetric]
op_ntcf_cf_ntcf_comp[symmetric]
assms(7,8)
cs_intro: cat_op_intros cat_cs_intros
)+
then show aou: "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
unfolding cf_adjunction_of_counit_def
by
(
subst 𝔉.cf_op_cf_op_cf[symmetric],
subst 𝔊.cf_op_cf_op_cf[symmetric],
subst ℭ.cat_op_cat_op_cat[symmetric],
subst 𝔇.cat_op_cat_op_cat[symmetric],
rule is_cf_adjunction_op
)
interpret aou: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 ‹cf_adjunction_of_counit α 𝔉 𝔊 ε›
by (rule aou)
show "η⇩C (cf_adjunction_of_counit α 𝔉 𝔊 ε) = η"
unfolding cf_adjunction_of_counit_def
by
(
cs_concl_step is_cf_adjunction.op_ntcf_cf_adjunction_counit[symmetric],
rule unit_op,
cs_concl_step counit_unit_is_cf_adjunction(3)[where ε=‹op_ntcf η›],
insert ℭ.category_op 𝔇.category_op
)
(
cs_concl
cs_simp:
cat_op_simps cat_cs_simps
𝔊.cf_ntcf_id_op_cf
𝔉.cf_ntcf_id_op_cf
op_ntcf_ntcf_vcomp[symmetric]
op_ntcf_ntcf_cf_comp[symmetric]
op_ntcf_cf_ntcf_comp[symmetric]
assms(7,8)
cs_intro: cat_op_intros cat_cs_intros
)+
show "ε⇩C (cf_adjunction_of_counit α 𝔉 𝔊 ε) = ε"
unfolding cf_adjunction_of_counit_def
by
(
cs_concl_step is_cf_adjunction.op_ntcf_cf_adjunction_unit[symmetric],
rule unit_op,
cs_concl_step counit_unit_is_cf_adjunction(2)[where ε=‹op_ntcf η›],
insert ℭ.category_op 𝔇.category_op
)
(
cs_concl
cs_simp:
cat_op_simps cat_cs_simps
𝔊.cf_ntcf_id_op_cf
𝔉.cf_ntcf_id_op_cf
op_ntcf_ntcf_vcomp[symmetric]
op_ntcf_ntcf_cf_comp[symmetric]
op_ntcf_cf_ntcf_comp[symmetric]
assms(7,8)
cs_intro: cat_op_intros cat_cs_intros
)+
qed
subsection‹Adjoints are unique up to isomorphism›
text‹
The content of the following subsection is based predominantly on
the statement and the proof of Corollary 1 in
Chapter IV-1 in \cite{mac_lane_categories_2010}. However, similar
results can also be found in section 4 in \cite{riehl_category_2016}
and in subsection 2.1 in \cite{bodo_categories_1970}.
›
subsubsection‹Definitions and elementary properties›
definition cf_adj_LR_iso :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ =
[
(
λx∈⇩∘ℭ⦇Obj⦈. THE f'.
let
η = η⇩C Φ;
η' = η⇩C Ψ;
𝔉x = 𝔉⦇ObjMap⦈⦇x⦈;
𝔉'x = 𝔉'⦇ObjMap⦈⦇x⦈
in
f' : 𝔉x ↦⇘𝔇⇙ 𝔉'x ∧
η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x (𝔉x) (η⦇NTMap⦈⦇x⦈) (𝔉'x)⦇ArrVal⦈⦇f'⦈
),
𝔉,
𝔉',
ℭ,
𝔇
]⇩∘"
definition cf_adj_RL_iso :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ =
[
(
λx∈⇩∘𝔇⦇Obj⦈. THE f'.
let
ε = ε⇩C Φ;
ε' = ε⇩C Ψ;
𝔊x = 𝔊⦇ObjMap⦈⦇x⦈;
𝔊'x = 𝔊'⦇ObjMap⦈⦇x⦈
in
f' : 𝔊'x ↦⇘ℭ⇙ 𝔊x ∧
ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f'⦈
),
𝔊',
𝔊,
𝔇,
ℭ
]⇩∘"
text‹Components.›
lemma cf_adj_LR_iso_components:
shows "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTMap⦈ =
(
λx∈⇩∘ℭ⦇Obj⦈. THE f'.
let
η = η⇩C Φ;
η' = η⇩C Ψ;
𝔉x = 𝔉⦇ObjMap⦈⦇x⦈;
𝔉'x = 𝔉'⦇ObjMap⦈⦇x⦈
in
f' : 𝔉x ↦⇘𝔇⇙ 𝔉'x ∧
η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f'⦈
)"
and [adj_cs_simps]: "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTDom⦈ = 𝔉"
and [adj_cs_simps]: "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTCod⦈ = 𝔉'"
and [adj_cs_simps]: "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTDGDom⦈ = ℭ"
and [adj_cs_simps]: "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTDGCod⦈ = 𝔇"
unfolding cf_adj_LR_iso_def nt_field_simps
by (simp_all add: nat_omega_simps)
lemma cf_adj_RL_iso_components:
shows "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTMap⦈ =
(
λx∈⇩∘𝔇⦇Obj⦈. THE f'.
let
ε = ε⇩C Φ;
ε' = ε⇩C Ψ;
𝔊x = 𝔊⦇ObjMap⦈⦇x⦈;
𝔊'x = 𝔊'⦇ObjMap⦈⦇x⦈
in
f' : 𝔊'x ↦⇘ℭ⇙ 𝔊x ∧
ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f'⦈
)"
and [adj_cs_simps]: "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTDom⦈ = 𝔊'"
and [adj_cs_simps]: "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTCod⦈ = 𝔊"
and [adj_cs_simps]: "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTDGDom⦈ = 𝔇"
and [adj_cs_simps]: "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTDGCod⦈ = ℭ"
unfolding cf_adj_RL_iso_def nt_field_simps
by (simp_all add: nat_omega_simps)
subsubsection‹Natural transformation map›
lemma cf_adj_LR_iso_vsv[adj_cs_intros]:
"vsv (cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTMap⦈)"
unfolding cf_adj_LR_iso_components by simp
lemma cf_adj_RL_iso_vsv[adj_cs_intros]:
"vsv (cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTMap⦈)"
unfolding cf_adj_RL_iso_components by simp
lemma cf_adj_LR_iso_vdomain[adj_cs_simps]:
"𝒟⇩∘ (cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTMap⦈) = ℭ⦇Obj⦈"
unfolding cf_adj_LR_iso_components by simp
lemma cf_adj_RL_iso_vdomain[adj_cs_simps]:
"𝒟⇩∘ (cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTMap⦈) = 𝔇⦇Obj⦈"
unfolding cf_adj_RL_iso_components by simp
lemma cf_adj_LR_iso_app:
fixes ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ
assumes "x ∈⇩∘ ℭ⦇Obj⦈"
defines "𝔉x ≡ 𝔉⦇ObjMap⦈⦇x⦈"
and "𝔉'x ≡ 𝔉'⦇ObjMap⦈⦇x⦈"
and "η ≡ η⇩C Φ"
and "η' ≡ η⇩C Ψ"
shows "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTMap⦈⦇x⦈ =
(
THE f'.
f' : 𝔉x ↦⇘𝔇⇙ 𝔉'x ∧
η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f'⦈
)"
using assms(1) unfolding cf_adj_LR_iso_components assms(2-5) by simp meson
lemma cf_adj_RL_iso_app:
fixes ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ
assumes "x ∈⇩∘ 𝔇⦇Obj⦈"
defines "𝔊x ≡ 𝔊⦇ObjMap⦈⦇x⦈"
and "𝔊'x ≡ 𝔊'⦇ObjMap⦈⦇x⦈"
and "ε ≡ ε⇩C Φ"
and "ε' ≡ ε⇩C Ψ"
shows "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTMap⦈⦇x⦈ =
(
THE f'.
f' : 𝔊'x ↦⇘ℭ⇙ 𝔊x ∧
ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f'⦈
)"
using assms(1) unfolding cf_adj_RL_iso_components assms(2-5) Let_def by simp
lemma cf_adj_LR_iso_app_unique:
fixes ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ
assumes "Φ : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "Ψ : 𝔉' ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "x ∈⇩∘ ℭ⦇Obj⦈"
defines "𝔉x ≡ 𝔉⦇ObjMap⦈⦇x⦈"
and "𝔉'x ≡ 𝔉'⦇ObjMap⦈⦇x⦈"
and "η ≡ η⇩C Φ"
and "η' ≡ η⇩C Ψ"
and "f ≡ cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ⦇NTMap⦈⦇x⦈"
shows
"∃!f'.
f' : 𝔉x ↦⇘𝔇⇙ 𝔉'x ∧
η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f'⦈"
"f : 𝔉x ↦⇩i⇩s⇩o⇘𝔇⇙ 𝔉'x"
"η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f⦈"
proof-
interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
interpret Ψ: is_cf_adjunction α ℭ 𝔇 𝔉' 𝔊 Ψ by (rule assms(2))
note 𝔉a_η =
is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
OF assms(1) assms(3), folded assms(4-8)
]
note 𝔉'a_η =
is_cf_adjunction.cf_adjunction_unit_component_is_ua_of[
OF assms(2) assms(3), folded assms(4-8)
]
from
is_functor.cf_universal_arrow_of_unique[
OF Φ.RL.is_functor_axioms 𝔉a_η 𝔉'a_η, folded assms(4-8)
]
obtain f'
where f': "f' : 𝔉x ↦⇘𝔇⇙ 𝔉'x"
and η'_def:
"η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f'⦈"
and unique_f':
"⟦
f'' : 𝔉x ↦⇘𝔇⇙ 𝔉'x;
η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f''⦈
⟧ ⟹ f'' = f'"
for f''
by metis
show unique_f': "∃!f'.
f' : 𝔉x ↦⇘𝔇⇙ 𝔉'x ∧
η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f'⦈"
by
(
rule is_functor.cf_universal_arrow_of_unique[
OF Φ.RL.is_functor_axioms 𝔉a_η 𝔉'a_η, folded assms(4-8)
]
)
from
theD
[
OF unique_f' cf_adj_LR_iso_app[
OF assms(3), of 𝔇 𝔊 𝔉 Φ 𝔉' Ψ, folded assms(4-8)
]
]
have f: "f : 𝔉x ↦⇘𝔇⇙ 𝔉'x"
and η': "η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f⦈"
by simp_all
show "η'⦇NTMap⦈⦇x⦈ = umap_of 𝔊 x 𝔉x (η⦇NTMap⦈⦇x⦈) 𝔉'x⦇ArrVal⦈⦇f⦈" by (rule η')
show "f : 𝔉x ↦⇩i⇩s⇩o⇘𝔇⇙ 𝔉'x"
by
(
rule
is_functor.cf_universal_arrow_of_is_arr_isomorphism[
OF Φ.RL.is_functor_axioms 𝔉a_η 𝔉'a_η f η'
]
)
qed
subsubsection‹Main results›
lemma cf_adj_LR_iso_is_iso_functor:
assumes "Φ : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇" and "Ψ : 𝔉' ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
shows "∃!θ.
θ : 𝔉 ↦⇩C⇩F 𝔉' : ℭ ↦↦⇩C⇘α⇙ 𝔇 ∧
η⇩C Ψ = (𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F θ) ∙⇩N⇩T⇩C⇩F η⇩C Φ"
and "cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ : 𝔉 ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔉' : ℭ ↦↦⇩C⇘α⇙ 𝔇"
and "η⇩C Ψ =
(𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ) ∙⇩N⇩T⇩C⇩F η⇩C Φ"
proof-
interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
interpret Ψ: is_cf_adjunction α ℭ 𝔇 𝔉' 𝔊 Ψ by (rule assms(2))
let ?η = ‹η⇩C Φ›
let ?η' = ‹η⇩C Ψ›
let ?ΦΨ = ‹cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ›
show 𝔉'Ψ: "?ΦΨ : 𝔉 ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔉' : ℭ ↦↦⇩C⇘α⇙ 𝔇"
proof(intro is_iso_ntcfI is_ntcfI')
show "vfsequence ?ΦΨ" unfolding cf_adj_LR_iso_def by auto
show "vcard ?ΦΨ = 5⇩ℕ"
unfolding cf_adj_LR_iso_def by (simp add: nat_omega_simps)
show "?ΦΨ⦇NTMap⦈⦇a⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘𝔇⇙ 𝔉'⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ ℭ⦇Obj⦈" for a
using cf_adj_LR_iso_app_unique(2)[OF assms that] by auto
show "?ΦΨ⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉'⦇ArrMap⦈⦇f⦈ ∘⇩A⇘𝔇⇙ ?ΦΨ⦇NTMap⦈⦇a⦈"
if "f : a ↦⇘ℭ⇙ b" for a b f
proof-
from that have a: "a ∈⇩∘ ℭ⦇Obj⦈" and b: "b ∈⇩∘ ℭ⦇Obj⦈" by auto
note unique_a = cf_adj_LR_iso_app_unique[OF assms a]
note unique_b = cf_adj_LR_iso_app_unique[OF assms b]
from unique_a(2) have a_is_arr:
"?ΦΨ⦇NTMap⦈⦇a⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘𝔇⇙ 𝔉'⦇ObjMap⦈⦇a⦈"
by auto
from unique_b(2) have b_is_arr:
"?ΦΨ⦇NTMap⦈⦇b⦈ : 𝔉⦇ObjMap⦈⦇b⦈ ↦⇘𝔇⇙ 𝔉'⦇ObjMap⦈⦇b⦈"
by auto
interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘⇩C⇩F 𝔉› ?η
by (rule Φ.cf_adjunction_unit_is_ntcf)
interpret η': is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘⇩C⇩F 𝔉'› ?η'
by (rule Ψ.cf_adjunction_unit_is_ntcf)
from unique_a(3) a_is_arr a b have η'_a_def:
"?η'⦇NTMap⦈⦇a⦈ = 𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇a⦈⦈ ∘⇩A⇘ℭ⇙ ?η⦇NTMap⦈⦇a⦈"
by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
from unique_b(3) b_is_arr a b have η'_b_def:
"?η'⦇NTMap⦈⦇b⦈ = 𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇b⦈⦈ ∘⇩A⇘ℭ⇙ ?η⦇NTMap⦈⦇b⦈"
by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
from that a b a_is_arr have
"𝔊⦇ArrMap⦈⦇𝔉'⦇ArrMap⦈⦇f⦈⦈ ∘⇩A⇘ℭ⇙
(𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇a⦈⦈ ∘⇩A⇘ℭ⇙ ?η⦇NTMap⦈⦇a⦈) =
𝔊⦇ArrMap⦈⦇𝔉'⦇ArrMap⦈⦇f⦈⦈ ∘⇩A⇘ℭ⇙ ?η'⦇NTMap⦈⦇a⦈"
by (cs_concl cs_simp: cat_cs_simps η'_a_def cs_intro: cat_cs_intros)
also from η'.ntcf_Comp_commute[OF that, symmetric] that a b have
"… = ?η'⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ f"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
also from that a b b_is_arr have
"… = 𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇b⦈⦈ ∘⇩A⇘ℭ⇙
(?η⦇NTMap⦈⦇b⦈ ∘⇩A⇘ℭ⇙ f)"
by (cs_concl cs_simp: cat_cs_simps η'_b_def cs_intro: cat_cs_intros)
also from that have
"… = 𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇b⦈⦈ ∘⇩A⇘ℭ⇙
((𝔊 ∘⇩C⇩F 𝔉)⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ ?η⦇NTMap⦈⦇a⦈)"
unfolding η.ntcf_Comp_commute[OF that, symmetric]
by (cs_concl cs_simp: cat_cs_simps η'_b_def cs_intro: cat_cs_intros)
also from that b_is_arr have
"… = 𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇b⦈⦈ ∘⇩A⇘ℭ⇙
(𝔊⦇ArrMap⦈⦇𝔉⦇ArrMap⦈⦇f⦈⦈ ∘⇩A⇘ℭ⇙ ?η⦇NTMap⦈⦇a⦈)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
finally have [cat_cs_simps]:
"𝔊⦇ArrMap⦈⦇𝔉'⦇ArrMap⦈⦇f⦈⦈ ∘⇩A⇘ℭ⇙ (𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇a⦈⦈ ∘⇩A⇘ℭ⇙
?η⦇NTMap⦈⦇a⦈) =
𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇b⦈⦈ ∘⇩A⇘ℭ⇙
(𝔊⦇ArrMap⦈⦇𝔉⦇ArrMap⦈⦇f⦈⦈ ∘⇩A⇘ℭ⇙ ?η⦇NTMap⦈⦇a⦈)"
by simp
note unique_f_a = is_functor.universal_arrow_ofD
[
OF
Φ.RL.is_functor_axioms
Φ.cf_adjunction_unit_component_is_ua_of[OF a]
]
from that a b a_is_arr b_is_arr have 𝔊𝔉f_ηa:
"𝔊⦇ArrMap⦈⦇𝔉'⦇ArrMap⦈⦇f⦈⦈ ∘⇩A⇘ℭ⇙ ?η'⦇NTMap⦈⦇a⦈ :
a ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇𝔉'⦇ObjMap⦈⦇b⦈⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from b have 𝔉'b: "𝔉'⦇ObjMap⦈⦇b⦈ ∈⇩∘ 𝔇⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from unique_f_a(3)[OF 𝔉'b 𝔊𝔉f_ηa] obtain f'
where f': "f' : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘𝔇⇙ 𝔉'⦇ObjMap⦈⦇b⦈"
and ηa: "𝔊⦇ArrMap⦈⦇𝔉'⦇ArrMap⦈⦇f⦈⦈ ∘⇩A⇘ℭ⇙ ?η'⦇NTMap⦈⦇a⦈ =
umap_of 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (?η⦇NTMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)⦇ArrVal⦈⦇f'⦈"
and unique_f':
"⟦
f'' : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘𝔇⇙ 𝔉'⦇ObjMap⦈⦇b⦈;
𝔊⦇ArrMap⦈⦇𝔉'⦇ArrMap⦈⦇f⦈⦈ ∘⇩A⇘ℭ⇙ ?η'⦇NTMap⦈⦇a⦈ =
umap_of 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (?η⦇NTMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)⦇ArrVal⦈⦇f''⦈
⟧ ⟹ f'' = f'"
for f''
by metis
have "?ΦΨ⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔇⇙ 𝔉⦇ArrMap⦈⦇f⦈ = f'"
by (rule unique_f', insert a b a_is_arr b_is_arr that)
(cs_concl cs_simp: η'_a_def cat_cs_simps cs_intro: cat_cs_intros)
moreover have "𝔉'⦇ArrMap⦈⦇f⦈ ∘⇩A⇘𝔇⇙ ?ΦΨ⦇NTMap⦈⦇a⦈ = f'"
by (rule unique_f', insert a b a_is_arr b_is_arr that)
(cs_concl cs_simp: η'_a_def cat_cs_simps cs_intro: cat_cs_intros)
ultimately show ?thesis by simp
qed
qed
(
auto
intro: cat_cs_intros adj_cs_intros
simp: adj_cs_simps cf_adj_LR_iso_app_unique(2)[OF assms]
)
interpret 𝔉'Ψ: is_iso_ntcf α ℭ 𝔇 𝔉 𝔉' ‹?ΦΨ› by (rule 𝔉'Ψ)
show η'_def: "?η' = 𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?ΦΨ ∙⇩N⇩T⇩C⇩F η⇩C Φ"
proof(rule ntcf_eqI)
have dom_lhs: "𝒟⇩∘ (?η'⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros)
have dom_rhs: "𝒟⇩∘ ((𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?ΦΨ ∙⇩N⇩T⇩C⇩F η⇩C Φ)⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
show "?η'⦇NTMap⦈ = (𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?ΦΨ ∙⇩N⇩T⇩C⇩F η⇩C Φ)⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ∈⇩∘ ℭ⦇Obj⦈"
note unique_a = cf_adj_LR_iso_app_unique[OF assms prems]
from unique_a(2) have a_is_arr:
"?ΦΨ⦇NTMap⦈⦇a⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘𝔇⇙ 𝔉'⦇ObjMap⦈⦇a⦈"
by auto
interpret η: is_ntcf α ℭ ℭ ‹cf_id ℭ› ‹𝔊 ∘⇩C⇩F 𝔉› ?η
by (rule Φ.cf_adjunction_unit_is_ntcf)
from unique_a(3) a_is_arr prems have η'_a_def:
"?η'⦇NTMap⦈⦇a⦈ = 𝔊⦇ArrMap⦈⦇?ΦΨ⦇NTMap⦈⦇a⦈⦈ ∘⇩A⇘ℭ⇙ η⇩C Φ⦇NTMap⦈⦇a⦈"
by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
from prems a_is_arr show
"?η'⦇NTMap⦈⦇a⦈ = (𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?ΦΨ ∙⇩N⇩T⇩C⇩F ?η)⦇NTMap⦈⦇a⦈"
by (cs_concl cs_simp: η'_a_def cat_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: cat_cs_intros adj_cs_intros)
qed (cs_concl cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)+
show "∃!θ. θ : 𝔉 ↦⇩C⇩F 𝔉' : ℭ ↦↦⇩C⇘α⇙ 𝔇 ∧ ?η' = (𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F θ) ∙⇩N⇩T⇩C⇩F ?η"
proof(intro ex1I conjI; (elim conjE)?)
from 𝔉'Ψ show "?ΦΨ : 𝔉 ↦⇩C⇩F 𝔉' : ℭ ↦↦⇩C⇘α⇙ 𝔇" by auto
show "?η' = 𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ?ΦΨ ∙⇩N⇩T⇩C⇩F η⇩C Φ" by (rule η'_def)
fix θ assume prems:
"θ : 𝔉 ↦⇩C⇩F 𝔉' : ℭ ↦↦⇩C⇘α⇙ 𝔇"
"?η' = 𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F θ ∙⇩N⇩T⇩C⇩F η⇩C Φ"
interpret θ: is_ntcf α ℭ 𝔇 𝔉 𝔉' θ by (rule prems(1))
from prems have η'_a:
"?η'⦇NTMap⦈⦇a⦈ = (𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F θ ∙⇩N⇩T⇩C⇩F η⇩C Φ)⦇NTMap⦈⦇a⦈"
for a
by simp
have η'a: "η⇩C Ψ⦇NTMap⦈⦇a⦈ =
𝔊⦇ArrMap⦈⦇θ⦇NTMap⦈⦇a⦈⦈ ∘⇩A⇘ℭ⇙ η⇩C Φ⦇NTMap⦈⦇a⦈"
if "a ∈⇩∘ ℭ⦇Obj⦈" for a
using η'_a[where a=a] that
by (cs_prems cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros)
show "θ = ?ΦΨ"
proof(rule ntcf_eqI)
have dom_lhs: "𝒟⇩∘ (θ⦇NTMap⦈) = ℭ⦇Obj⦈" by (cs_concl cs_simp: cat_cs_simps)
have dom_rhs: "𝒟⇩∘ (?ΦΨ⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
show "θ⦇NTMap⦈ = ?ΦΨ⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems': "a ∈⇩∘ ℭ⦇Obj⦈"
let ?uof = ‹umap_of 𝔊 a (𝔉⦇ObjMap⦈⦇a⦈) (?η⦇NTMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇a⦈)›
from cf_adj_LR_iso_app_unique[OF assms prems'] obtain f'
where f': "f' : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘𝔇⇙ 𝔉'⦇ObjMap⦈⦇a⦈"
and η_def: "?η'⦇NTMap⦈⦇a⦈ = ?uof⦇ArrVal⦈⦇f'⦈"
and unique_f': "⋀f''.
⟦
f'' : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘𝔇⇙ 𝔉'⦇ObjMap⦈⦇a⦈;
?η'⦇NTMap⦈⦇a⦈ = ?uof⦇ArrVal⦈⦇f''⦈
⟧ ⟹ f'' = f'"
by metis
from prems' have θa: "θ⦇NTMap⦈⦇a⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘𝔇⇙ 𝔉'⦇ObjMap⦈⦇a⦈"
by (cs_concl cs_simp: cs_intro: cat_cs_intros)
from η_def f' prems' have
"η⇩C Ψ⦇NTMap⦈⦇a⦈ = 𝔊⦇ArrMap⦈⦇f'⦈ ∘⇩A⇘ℭ⇙ η⇩C Φ⦇NTMap⦈⦇a⦈"
by
(
cs_prems
cs_simp: cat_cs_simps cs_intro: adj_cs_intros cat_cs_intros
)
from prems' have "η⇩C Ψ⦇NTMap⦈⦇a⦈ = ?uof⦇ArrVal⦈⦇θ⦇NTMap⦈⦇a⦈⦈"
by
(
cs_concl
cs_simp: cat_cs_simps η'a[OF prems']
cs_intro: adj_cs_intros cat_cs_intros
)
from unique_f'[OF θa this] have θa: "θ⦇NTMap⦈⦇a⦈ = f'".
from prems' have Ψa:
"?ΦΨ⦇NTMap⦈⦇a⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘𝔇⇙ 𝔉'⦇ObjMap⦈⦇a⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from prems' have "η⇩C Ψ⦇NTMap⦈⦇a⦈ = ?uof⦇ArrVal⦈⦇?ΦΨ⦇NTMap⦈⦇a⦈⦈"
by
(
cs_concl
cs_simp: cf_adj_LR_iso_app_unique(3)[OF assms] cat_cs_simps
cs_intro: adj_cs_intros cat_cs_intros
)
from unique_f'[OF Ψa this] have 𝔉'Ψ_def: "?ΦΨ⦇NTMap⦈⦇a⦈ = f'".
show "θ⦇NTMap⦈⦇a⦈ = ?ΦΨ⦇NTMap⦈⦇a⦈" unfolding θa 𝔉'Ψ_def ..
qed auto
qed (cs_concl cs_simp: cs_intro: cat_cs_intros)+
qed
qed
lemma op_ntcf_cf_adj_RL_iso[cat_op_simps]:
assumes "Φ : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "Ψ : 𝔉 ⇌⇩C⇩F 𝔊' : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
defines "op_𝔇 ≡ op_cat 𝔇"
and "op_ℭ ≡ op_cat ℭ"
and "op_𝔉 ≡ op_cf 𝔉"
and "op_𝔊 ≡ op_cf 𝔊"
and "op_Φ ≡ op_cf_adj Φ"
and "op_𝔊' ≡ op_cf 𝔊'"
and "op_Ψ ≡ op_cf_adj Ψ"
shows
"op_ntcf (cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ) =
cf_adj_LR_iso op_𝔇 op_ℭ op_𝔉 op_𝔊 op_Φ op_𝔊' op_Ψ"
proof-
interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
interpret Ψ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊' Ψ by (rule assms(2))
interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘⇩C⇩F 𝔊› ‹cf_id 𝔇› ‹ε⇩C Φ›
by (rule Φ.cf_adjunction_counit_is_ntcf)
have dom_lhs: "𝒟⇩∘ (op_ntcf (cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ)) = 5⇩ℕ"
unfolding op_ntcf_def by (simp add: nat_omega_simps)
show ?thesis
proof(rule vsv_eqI, unfold dom_lhs)
fix a assume prems: "a ∈⇩∘ 5⇩ℕ"
then have "a ∈⇩∘ 5⇩ℕ" unfolding dom_lhs by simp
then show
"op_ntcf (cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ)⦇a⦈ =
cf_adj_LR_iso op_𝔇 op_ℭ op_𝔉 op_𝔊 op_Φ op_𝔊' op_Ψ⦇a⦈"
by
(
elim_in_numeral,
fold nt_field_simps,
unfold
cf_adj_LR_iso_components
op_ntcf_components
cf_adj_RL_iso_components
Let_def
Φ.cf_adjunction_unit_NTMap_op
Ψ.cf_adjunction_unit_NTMap_op
assms(3-9)
cat_op_simps
)
simp_all
qed (auto simp: op_ntcf_def cf_adj_LR_iso_def nat_omega_simps)
qed
lemma op_ntcf_cf_adj_LR_iso[cat_op_simps]:
assumes "Φ : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇" and "Ψ : 𝔉' ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
defines "op_𝔇 ≡ op_cat 𝔇"
and "op_ℭ ≡ op_cat ℭ"
and "op_𝔉 ≡ op_cf 𝔉"
and "op_𝔊 ≡ op_cf 𝔊"
and "op_Φ ≡ op_cf_adj Φ"
and "op_𝔉' ≡ op_cf 𝔉'"
and "op_Ψ ≡ op_cf_adj Ψ"
shows
"op_ntcf (cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ) =
cf_adj_RL_iso op_𝔇 op_ℭ op_𝔊 op_𝔉 op_Φ op_𝔉' op_Ψ"
proof-
interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
interpret Ψ: is_cf_adjunction α ℭ 𝔇 𝔉' 𝔊 Ψ by (rule assms(2))
interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘⇩C⇩F 𝔊› ‹cf_id 𝔇› ‹ε⇩C Φ›
by (rule Φ.cf_adjunction_counit_is_ntcf)
have dom_lhs: "𝒟⇩∘ (op_ntcf (cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ)) = 5⇩ℕ"
unfolding op_ntcf_def by (simp add: nat_omega_simps)
show ?thesis
proof(rule vsv_eqI, unfold dom_lhs)
fix a assume prems: "a ∈⇩∘ 5⇩ℕ"
then show
"op_ntcf (cf_adj_LR_iso ℭ 𝔇 𝔊 𝔉 Φ 𝔉' Ψ)⦇a⦈ =
cf_adj_RL_iso op_𝔇 op_ℭ op_𝔊 op_𝔉 op_Φ op_𝔉' op_Ψ⦇a⦈"
by
(
elim_in_numeral,
use nothing in
‹
fold nt_field_simps,
unfold
cf_adj_LR_iso_components
op_ntcf_components
cf_adj_RL_iso_components
Let_def
Φ.op_ntcf_cf_adjunction_unit[symmetric]
Ψ.op_ntcf_cf_adjunction_unit[symmetric]
assms(3-9)
cat_op_simps
›
)
simp_all
qed (auto simp: op_ntcf_def cf_adj_RL_iso_def nat_omega_simps)
qed
lemma cf_adj_RL_iso_app_unique:
fixes ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ
assumes "Φ : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "Ψ : 𝔉 ⇌⇩C⇩F 𝔊' : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
and "x ∈⇩∘ 𝔇⦇Obj⦈"
defines "𝔊x ≡ 𝔊⦇ObjMap⦈⦇x⦈"
and "𝔊'x ≡ 𝔊'⦇ObjMap⦈⦇x⦈"
and "ε ≡ ε⇩C Φ"
and "ε' ≡ ε⇩C Ψ"
and "f ≡ cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ⦇NTMap⦈⦇x⦈"
shows
"∃!f'.
f' : 𝔊'x ↦⇘ℭ⇙ 𝔊x ∧
ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f'⦈"
"f : 𝔊'x ↦⇩i⇩s⇩o⇘ℭ⇙ 𝔊x"
"ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f⦈"
proof-
interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
interpret Ψ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊' Ψ by (rule assms(2))
interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘⇩C⇩F 𝔊› ‹cf_id 𝔇› ‹ε⇩C Φ›
by (rule Φ.cf_adjunction_counit_is_ntcf)
show
"∃!f'.
f' : 𝔊'x ↦⇘ℭ⇙ 𝔊x ∧
ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f'⦈"
"f : 𝔊'x ↦⇩i⇩s⇩o⇘ℭ⇙ 𝔊x"
"ε'⦇NTMap⦈⦇x⦈ = umap_fo 𝔉 x 𝔊x (ε⦇NTMap⦈⦇x⦈) 𝔊'x⦇ArrVal⦈⦇f⦈"
by
(
intro cf_adj_LR_iso_app_unique
[
OF Φ.is_cf_adjunction_op Ψ.is_cf_adjunction_op,
unfolded cat_op_simps,
OF assms(3),
unfolded Ψ.cf_adjunction_unit_NTMap_op,
folded Φ.op_ntcf_cf_adjunction_counit,
folded op_ntcf_cf_adj_RL_iso[OF assms(1,2)],
unfolded cat_op_simps,
folded assms(4-8)
]
)+
qed
lemma cf_adj_RL_iso_is_iso_functor:
assumes "Φ : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇" and "Ψ : 𝔉 ⇌⇩C⇩F 𝔊' : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
shows "∃!θ.
θ : 𝔊' ↦⇩C⇩F 𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ ∧
ε⇩C Ψ = ε⇩C Φ ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F θ)"
and "cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ : 𝔊' ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
and "ε⇩C Ψ =
ε⇩C Φ ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ)"
proof-
interpret Φ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊 Φ by (rule assms(1))
interpret Ψ: is_cf_adjunction α ℭ 𝔇 𝔉 𝔊' Ψ by (rule assms(2))
interpret ε: is_ntcf α 𝔇 𝔇 ‹𝔉 ∘⇩C⇩F 𝔊› ‹cf_id 𝔇› ‹ε⇩C Φ›
by (rule Φ.cf_adjunction_counit_is_ntcf)
note cf_adj_LR_iso_is_iso_functor_op = cf_adj_LR_iso_is_iso_functor
[
OF Φ.is_cf_adjunction_op Ψ.is_cf_adjunction_op,
folded
Φ.op_ntcf_cf_adjunction_counit
Ψ.op_ntcf_cf_adjunction_counit
op_ntcf_cf_adj_RL_iso[OF assms]
]
from cf_adj_LR_iso_is_iso_functor_op(1) obtain θ
where θ: "θ : op_cf 𝔊 ↦⇩C⇩F op_cf 𝔊' : op_cat 𝔇 ↦↦⇩C⇘α⇙ op_cat ℭ"
and op_ntcf_ε_def: "op_ntcf (ε⇩C Ψ) =
op_cf 𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F θ ∙⇩N⇩T⇩C⇩F op_ntcf (ε⇩C Φ)"
and unique_θ':
"⟦
θ' : op_cf 𝔊 ↦⇩C⇩F op_cf 𝔊' : op_cat 𝔇 ↦↦⇩C⇘α⇙ op_cat ℭ;
op_ntcf (ε⇩C Ψ) = op_cf 𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F θ' ∙⇩N⇩T⇩C⇩F op_ntcf (ε⇩C Φ)
⟧ ⟹ θ' = θ"
for θ'
by metis
interpret θ: is_ntcf α ‹op_cat 𝔇› ‹op_cat ℭ› ‹op_cf 𝔊› ‹op_cf 𝔊'› θ
by (rule θ)
show "∃!θ. θ : 𝔊' ↦⇩C⇩F 𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ ∧ ε⇩C Ψ = ε⇩C Φ ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F θ)"
proof(intro ex1I conjI; (elim conjE)?)
show op_θ: "op_ntcf θ : 𝔊' ↦⇩C⇩F 𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
by (rule θ.is_ntcf_op[unfolded cat_op_simps])
from op_ntcf_ε_def have
"op_ntcf (op_ntcf (ε⇩C Ψ)) =
op_ntcf (op_cf 𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F θ ∙⇩N⇩T⇩C⇩F op_ntcf (ε⇩C Φ))"
by simp
then show ε_def: "ε⇩C Ψ = ε⇩C Φ ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F op_ntcf θ)"
by
(
cs_prems
cs_simp: cat_op_simps
cs_intro: adj_cs_intros cat_cs_intros cat_op_intros
)
fix θ' assume prems:
"θ' : 𝔊' ↦⇩C⇩F 𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
"ε⇩C Ψ = ε⇩C Φ ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F θ')"
interpret θ': is_ntcf α 𝔇 ℭ 𝔊' 𝔊 θ' by (rule prems(1))
have "op_ntcf (ε⇩C Ψ) = op_cf 𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F op_ntcf θ' ∙⇩N⇩T⇩C⇩F op_ntcf (ε⇩C Φ)"
by
(
cs_concl
cs_simp:
prems(2)
op_ntcf_cf_ntcf_comp[symmetric]
op_ntcf_ntcf_vcomp[symmetric]
cs_intro: cat_cs_intros
)
from unique_θ'[OF θ'.is_ntcf_op this, symmetric] have
"op_ntcf θ = op_ntcf (op_ntcf θ')"
by simp
then show "θ' = op_ntcf θ"
by (cs_prems cs_simp: cat_cs_simps cat_op_simps) simp
qed
from is_iso_ntcf.is_iso_ntcf_op[OF cf_adj_LR_iso_is_iso_functor_op(2)] show
"cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ : 𝔊' ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔊 : 𝔇 ↦↦⇩C⇘α⇙ ℭ"
by (cs_prems cs_simp: cat_op_simps cs_intro: adj_cs_intros cat_op_intros)
from cf_adj_LR_iso_is_iso_functor_op(3) have
"op_ntcf (op_ntcf (ε⇩C Ψ)) =
op_ntcf
(
op_cf 𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F op_ntcf (cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ) ∙⇩N⇩T⇩C⇩F
op_ntcf (ε⇩C Φ)
)"
by simp
from
this
cf_adj_LR_iso_is_iso_functor_op(2)[
unfolded op_ntcf_cf_adj_RL_iso[OF assms]
]
show "ε⇩C Ψ = ε⇩C Φ ∙⇩N⇩T⇩C⇩F (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F cf_adj_RL_iso ℭ 𝔇 𝔉 𝔊 Φ 𝔊' Ψ)"
by
(
cs_prems
cs_simp: cat_op_simps cat_op_simps
cs_intro: ntcf_cs_intros adj_cs_intros cat_cs_intros cat_op_intros
)
qed
subsection‹Further properties of the adjoint functors›
lemma (in is_cf_adjunction) cf_adj_exp_cf_cat:
assumes "𝒵 β" and "α ∈⇩∘ β" and "category α 𝔍"
shows
"cf_adjunction_of_unit
β
(exp_cf_cat α 𝔉 𝔍)
(exp_cf_cat α 𝔊 𝔍)
(exp_ntcf_cat α (η⇩C Φ) 𝔍) :
exp_cf_cat α 𝔉 𝔍 ⇌⇩C⇩F exp_cf_cat α 𝔊 𝔍 :
cat_FUNCT α 𝔍 ℭ ⇌⇌⇩C⇘β⇙ cat_FUNCT α 𝔍 𝔇"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret 𝔍: category α 𝔍 by (rule assms(3))
show ?thesis
proof
(
rule counit_unit_is_cf_adjunction(1)[
where ε = ‹exp_ntcf_cat α (ε⇩C Φ) 𝔍›
]
)
from assms show "exp_ntcf_cat α (η⇩C Φ) 𝔍 :
cf_id (cat_FUNCT α 𝔍 ℭ) ↦⇩C⇩F exp_cf_cat α 𝔊 𝔍 ∘⇩C⇩F exp_cf_cat α 𝔉 𝔍 :
cat_FUNCT α 𝔍 ℭ ↦↦⇩C⇘β⇙ cat_FUNCT α 𝔍 ℭ"
by
(
cs_concl
cs_simp:
cat_cs_simps cat_FUNCT_cs_simps
exp_cf_cat_cf_id_cat[symmetric] exp_cf_cat_cf_comp[symmetric]
cs_intro:
cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
)
from assms show
"exp_ntcf_cat α (ε⇩C Φ) 𝔍 :
exp_cf_cat α 𝔉 𝔍 ∘⇩C⇩F exp_cf_cat α 𝔊 𝔍 ↦⇩C⇩F cf_id (cat_FUNCT α 𝔍 𝔇) :
cat_FUNCT α 𝔍 𝔇 ↦↦⇩C⇘β⇙ cat_FUNCT α 𝔍 𝔇"
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_FUNCT_cs_simps
exp_cf_cat_cf_id_cat[symmetric]
exp_cf_cat_cf_comp[symmetric]
cs_intro:
cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
)
note [symmetric, cat_cs_simps] =
ntcf_id_exp_cf_cat
exp_ntcf_cat_ntcf_vcomp
exp_ntcf_cat_ntcf_cf_comp
exp_ntcf_cat_cf_ntcf_comp
from assms show
"(exp_cf_cat α 𝔊 𝔍 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F exp_ntcf_cat α (ε⇩C Φ) 𝔍) ∙⇩N⇩T⇩C⇩F
(exp_ntcf_cat α (η⇩C Φ) 𝔍 ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F exp_cf_cat α 𝔊 𝔍) =
ntcf_id (exp_cf_cat α 𝔊 𝔍)"
by
(
cs_concl
cs_simp: adj_cs_simps cat_cs_simps
cs_intro: adj_cs_intros cat_cs_intros
)
from assms show
"exp_ntcf_cat α (ε⇩C Φ) 𝔍 ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F exp_cf_cat α 𝔉 𝔍 ∙⇩N⇩T⇩C⇩F
(exp_cf_cat α 𝔉 𝔍 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F exp_ntcf_cat α (η⇩C Φ) 𝔍) =
ntcf_id (exp_cf_cat α 𝔉 𝔍)"
by
(
cs_concl
cs_simp: adj_cs_simps cat_cs_simps
cs_intro: adj_cs_intros cat_cs_intros
)
qed
(
use assms in
‹
cs_concl
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
›
)+
qed
lemma (in is_cf_adjunction) cf_adj_exp_cf_cat_exp_cf_cat:
assumes "𝒵 β" and "α ∈⇩∘ β" and "category α 𝔄"
shows
"cf_adjunction_of_unit
β
(exp_cat_cf α 𝔄 𝔊)
(exp_cat_cf α 𝔄 𝔉)
(exp_cat_ntcf α 𝔄 (η⇩C Φ)) :
exp_cat_cf α 𝔄 𝔊 ⇌⇩C⇩F exp_cat_cf α 𝔄 𝔉 :
cat_FUNCT α ℭ 𝔄 ⇌⇌⇩C⇘β⇙ cat_FUNCT α 𝔇 𝔄"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret 𝔄: category α 𝔄 by (rule assms(3))
show ?thesis
proof
(
rule counit_unit_is_cf_adjunction(1)[
where ε = ‹exp_cat_ntcf α 𝔄 (ε⇩C Φ)›
]
)
from assms is_cf_adjunction_axioms show
"exp_cat_ntcf α 𝔄 (η⇩C Φ) :
cf_id (cat_FUNCT α ℭ 𝔄) ↦⇩C⇩F exp_cat_cf α 𝔄 𝔉 ∘⇩C⇩F exp_cat_cf α 𝔄 𝔊 :
cat_FUNCT α ℭ 𝔄 ↦↦⇩C⇘β⇙ cat_FUNCT α ℭ 𝔄"
by
(
cs_concl
cs_simp:
exp_cat_cf_cat_cf_id[symmetric] exp_cat_cf_cf_comp[symmetric]
cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
)
from assms is_cf_adjunction_axioms show
"exp_cat_ntcf α 𝔄 (ε⇩C Φ) :
exp_cat_cf α 𝔄 𝔊 ∘⇩C⇩F exp_cat_cf α 𝔄 𝔉 ↦⇩C⇩F cf_id (cat_FUNCT α 𝔇 𝔄) :
cat_FUNCT α 𝔇 𝔄 ↦↦⇩C⇘β⇙ cat_FUNCT α 𝔇 𝔄"
by
(
cs_concl
cs_simp:
exp_cat_cf_cat_cf_id[symmetric] exp_cat_cf_cf_comp[symmetric]
cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros adj_cs_intros
)
note [symmetric, cat_cs_simps] =
ntcf_id_exp_cat_cf
exp_cat_ntcf_ntcf_vcomp
exp_cat_ntcf_ntcf_cf_comp
exp_cat_ntcf_cf_ntcf_comp
from assms show
"exp_cat_cf α 𝔄 𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F exp_cat_ntcf α 𝔄 (ε⇩C Φ) ∙⇩N⇩T⇩C⇩F
(exp_cat_ntcf α 𝔄 (η⇩C Φ) ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F exp_cat_cf α 𝔄 𝔉) =
ntcf_id (exp_cat_cf α 𝔄 𝔉)"
by
(
cs_concl
cs_simp: adj_cs_simps cat_cs_simps
cs_intro: adj_cs_intros cat_cs_intros
)
from assms show
"exp_cat_ntcf α 𝔄 (ε⇩C Φ) ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F exp_cat_cf α 𝔄 𝔊 ∙⇩N⇩T⇩C⇩F
(exp_cat_cf α 𝔄 𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F exp_cat_ntcf α 𝔄 (η⇩C Φ)) =
ntcf_id (exp_cat_cf α 𝔄 𝔊)"
by
(
cs_concl
cs_simp: adj_cs_simps cat_cs_simps
cs_intro: adj_cs_intros cat_cs_intros
)
qed
(
use assms in
‹
cs_concl
cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
›
)+
qed
text‹\newpage›
end
Theory CZH_UCAT_Kan
section‹Simple Kan extensions›
theory CZH_UCAT_Kan
imports
CZH_Elementary_Categories.CZH_ECAT_Comma
CZH_UCAT_Limit
CZH_UCAT_Adjoints
begin
subsection‹Background›
named_theorems ua_field_simps
definition UObj :: V where [ua_field_simps]: "UObj = 0"
definition UArr :: V where [ua_field_simps]: "UArr = 1⇩ℕ"
named_theorems cat_Kan_cs_simps
named_theorems cat_Kan_cs_intros
subsection‹Kan extension›
subsubsection‹Definition and elementary properties›
text‹See Chapter X-3 in \cite{mac_lane_categories_2010}.›
locale is_cat_rKe =
AG: is_functor α 𝔅 ℭ 𝔎 +
Ran: is_functor α ℭ 𝔄 𝔊 +
ntcf_rKe: is_ntcf α 𝔅 𝔄 ‹𝔊 ∘⇩C⇩F 𝔎› 𝔗 ε
for α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔊 ε +
assumes cat_rKe_ua_fo:
"universal_arrow_fo
(exp_cat_cf α 𝔄 𝔎)
(cf_map 𝔗)
(cf_map 𝔊)
(ntcf_arrow ε)"
syntax "_is_cat_rKe" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ ∘⇩C⇩F _ ↦⇩C⇩F⇩.⇩r⇩K⇩eı _ :/ _ ↦⇩C _ ↦⇩C _)› [51, 51, 51, 51, 51, 51, 51] 51)
translations "ε : 𝔊 ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 : 𝔅 ↦⇩C ℭ ↦⇩C 𝔄" ⇌
"CONST is_cat_rKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔊 ε"
locale is_cat_lKe =
AG: is_functor α 𝔅 ℭ 𝔎 +
Lan: is_functor α ℭ 𝔄 𝔉 +
ntcf_lKe: is_ntcf α 𝔅 𝔄 𝔗 ‹𝔉 ∘⇩C⇩F 𝔎› η
for α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔉 η +
assumes cat_lKe_ua_fo:
"universal_arrow_fo
(exp_cat_cf α (op_cat 𝔄) (op_cf 𝔎))
(cf_map 𝔗)
(cf_map 𝔉)
(ntcf_arrow (op_ntcf η))"
syntax "_is_cat_lKe" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(‹(_ :/ _ ↦⇩C⇩F⇩.⇩l⇩K⇩eı _ ∘⇩C⇩F _ :/ _ ↦⇩C _ ↦⇩C _)› [51, 51, 51, 51, 51, 51, 51] 51)
translations "η : 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ 𝔉 ∘⇩C⇩F 𝔎 : 𝔅 ↦⇩C ℭ ↦⇩C 𝔄" ⇌
"CONST is_cat_lKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔉 η"
text‹Rules.›
lemma (in is_cat_rKe) is_cat_rKe_axioms'[cat_Kan_cs_intros]:
assumes "α' = α"
and "𝔊' = 𝔊"
and "𝔎' = 𝔎"
and "𝔗' = 𝔗"
and "𝔅' = 𝔅"
and "𝔄' = 𝔄"
and "ℭ' = ℭ"
shows "ε : 𝔊' ∘⇩C⇩F 𝔎' ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α'⇙ 𝔗' : 𝔅' ↦⇩C ℭ' ↦⇩C 𝔄'"
unfolding assms by (rule is_cat_rKe_axioms)
mk_ide rf is_cat_rKe_def[unfolded is_cat_rKe_axioms_def]
|intro is_cat_rKeI|
|dest is_cat_rKeD[dest]|
|elim is_cat_rKeE[elim]|
lemmas [cat_Kan_cs_intros] = is_cat_rKeD(1-3)
lemma (in is_cat_lKe) is_cat_lKe_axioms'[cat_Kan_cs_intros]:
assumes "α' = α"
and "𝔉' = 𝔉"
and "𝔎' = 𝔎"
and "𝔗' = 𝔗"
and "𝔅' = 𝔅"
and "𝔄' = 𝔄"
and "ℭ' = ℭ"
shows "η : 𝔗' ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ 𝔉' ∘⇩C⇩F 𝔎' : 𝔅' ↦⇩C ℭ' ↦⇩C 𝔄'"
unfolding assms by (rule is_cat_lKe_axioms)
mk_ide rf is_cat_lKe_def[unfolded is_cat_lKe_axioms_def]
|intro is_cat_lKeI|
|dest is_cat_lKeD[dest]|
|elim is_cat_lKeE[elim]|
lemmas [cat_Kan_cs_intros] = is_cat_lKeD(1-3)
text‹Duality.›
lemma (in is_cat_rKe) is_cat_lKe_op:
"op_ntcf ε :
op_cf 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ op_cf 𝔊 ∘⇩C⇩F op_cf 𝔎 :
op_cat 𝔅 ↦⇩C op_cat ℭ ↦⇩C op_cat 𝔄"
by (intro is_cat_lKeI, unfold cat_op_simps; (intro cat_rKe_ua_fo)?)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
lemma (in is_cat_rKe) is_cat_lKe_op'[cat_op_intros]:
assumes "𝔗' = op_cf 𝔗"
and "𝔊' = op_cf 𝔊"
and "𝔎' = op_cf 𝔎"
and "𝔅' = op_cat 𝔅"
and "𝔄' = op_cat 𝔄"
and "ℭ' = op_cat ℭ"
shows "op_ntcf ε : 𝔗' ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ 𝔊' ∘⇩C⇩F 𝔎' : 𝔅' ↦⇩C ℭ' ↦⇩C 𝔄'"
unfolding assms by (rule is_cat_lKe_op)
lemmas [cat_op_intros] = is_cat_rKe.is_cat_lKe_op'
lemma (in is_cat_lKe) is_cat_rKe_op:
"op_ntcf η :
op_cf 𝔉 ∘⇩C⇩F op_cf 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ op_cf 𝔗 :
op_cat 𝔅 ↦⇩C op_cat ℭ ↦⇩C op_cat 𝔄"
by (intro is_cat_rKeI, unfold cat_op_simps; (intro cat_lKe_ua_fo)?)
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
lemma (in is_cat_lKe) is_cat_lKe_op'[cat_op_intros]:
assumes "𝔗' = op_cf 𝔗"
and "𝔉' = op_cf 𝔉"
and "𝔎' = op_cf 𝔎"
and "𝔅' = op_cat 𝔅"
and "𝔄' = op_cat 𝔄"
and "ℭ' = op_cat ℭ"
shows "op_ntcf η : 𝔉' ∘⇩C⇩F 𝔎' ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗' : 𝔅' ↦⇩C ℭ' ↦⇩C 𝔄'"
unfolding assms by (rule is_cat_rKe_op)
lemmas [cat_op_intros] = is_cat_lKe.is_cat_lKe_op'
text‹Elementary properties.›
lemma (in is_cat_rKe) cat_rKe_exp_cat_cf_cat_FUNCT_is_arr:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "exp_cat_cf α 𝔄 𝔎 : cat_FUNCT α ℭ 𝔄 ↦↦⇩C⇩.⇩t⇩i⇩n⇩y⇘β⇙ cat_FUNCT α 𝔅 𝔄"
by
(
rule exp_cat_cf_is_tiny_functor[
OF assms Ran.HomCod.category_axioms AG.is_functor_axioms
]
)
lemma (in is_cat_lKe) cat_lKe_exp_cat_cf_cat_FUNCT_is_arr:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "exp_cat_cf α 𝔄 𝔎 : cat_FUNCT α ℭ 𝔄 ↦↦⇩C⇩.⇩t⇩i⇩n⇩y⇘β⇙ cat_FUNCT α 𝔅 𝔄"
by
(
rule exp_cat_cf_is_tiny_functor[
OF assms Lan.HomCod.category_axioms AG.is_functor_axioms
]
)
subsubsection‹Universal property›
text‹
See Chapter X-3 in \cite{mac_lane_categories_2010} and
\cite{noauthor_wikipedia_2001}\footnote{
\url{https://en.wikipedia.org/wiki/Kan_extension}
}.
›
lemma is_cat_rKeI':
assumes "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔊 : ℭ ↦↦⇩C⇘α⇙ 𝔄"
and "ε : 𝔊 ∘⇩C⇩F 𝔎 ↦⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "⋀𝔊' ε'.
⟦ 𝔊' : ℭ ↦↦⇩C⇘α⇙ 𝔄; ε' : 𝔊' ∘⇩C⇩F 𝔎 ↦⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄 ⟧ ⟹
∃!σ. σ : 𝔊' ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ 𝔄 ∧ ε' = ε ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
shows "ε : 𝔊 ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 : 𝔅 ↦⇩C ℭ ↦⇩C 𝔄"
proof-
interpret 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔊: is_functor α ℭ 𝔄 𝔊 by (rule assms(2))
interpret ε: is_ntcf α 𝔅 𝔄 ‹𝔊 ∘⇩C⇩F 𝔎› 𝔗 ε by (rule assms(3))
let ?𝔄𝔎 = ‹exp_cat_cf α 𝔄 𝔎›
and ?𝔗 = ‹cf_map 𝔗›
and ?𝔊 = ‹cf_map 𝔊›
show ?thesis
proof(intro is_cat_rKeI is_functor.universal_arrow_foI assms)
define β where "β = α + ω"
have "𝒵 β" and αβ: "α ∈⇩∘ β"
by (simp_all add: β_def 𝔎.𝒵_Limit_αω 𝔎.𝒵_ω_αω 𝒵_def 𝔎.𝒵_α_αω)
then interpret β: 𝒵 β by simp
show "?𝔄𝔎 : cat_FUNCT α ℭ 𝔄 ↦↦⇩C⇘β⇙ cat_FUNCT α 𝔅 𝔄"
by
(
cs_concl cs_intro:
cat_small_cs_intros
exp_cat_cf_is_tiny_functor[
OF β.𝒵_axioms αβ 𝔊.HomCod.category_axioms assms(1)
]
)
from αβ assms(2) show "cf_map 𝔊 ∈⇩∘ cat_FUNCT α ℭ 𝔄⦇Obj⦈"
unfolding cat_FUNCT_components
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_FUNCT_cs_intros)
from assms(1-3) show "ntcf_arrow ε :
?𝔄𝔎⦇ObjMap⦈⦇?𝔊⦈ ↦⇘cat_FUNCT α 𝔅 𝔄⇙ ?𝔗"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps cat_FUNCT_components(1)
cs_intro: cat_FUNCT_cs_intros
)
fix 𝔉' ε' assume prems:
"𝔉' ∈⇩∘ cat_FUNCT α ℭ 𝔄⦇Obj⦈"
"ε' : ?𝔄𝔎⦇ObjMap⦈⦇𝔉'⦈ ↦⇘cat_FUNCT α 𝔅 𝔄⇙ ?𝔗"
from prems(1) have "𝔉' ∈⇩∘ cf_maps α ℭ 𝔄"
unfolding cat_FUNCT_components(1) by simp
then obtain 𝔉 where 𝔉'_def: "𝔉' = cf_map 𝔉" and 𝔉: "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔄"
by clarsimp
note ε' = cat_FUNCT_is_arrD[OF prems(2)]
from ε'(1) 𝔉 have ε'_is_ntcf:
"ntcf_of_ntcf_arrow 𝔅 𝔄 ε' : 𝔉 ∘⇩C⇩F 𝔎 ↦⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
by
(
cs_prems
cs_simp: 𝔉'_def cat_Kan_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
from assms(4)[OF 𝔉 ε'_is_ntcf] obtain σ
where σ: "σ : 𝔉 ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ 𝔄"
and ε'_def': "ntcf_of_ntcf_arrow 𝔅 𝔄 ε' = ε ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
and unique_σ: "⋀σ'.
⟦
σ' : 𝔉 ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ 𝔄;
ntcf_of_ntcf_arrow 𝔅 𝔄 ε' = ε ∙⇩N⇩T⇩C⇩F (σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)
⟧ ⟹ σ' = σ"
by metis
show "∃!f'.
f' : 𝔉' ↦⇘cat_FUNCT α ℭ 𝔄⇙ ?𝔊 ∧
ε' = umap_fo ?𝔄𝔎 ?𝔗 ?𝔊 (ntcf_arrow ε) 𝔉'⦇ArrVal⦈⦇f'⦈"
proof(intro ex1I conjI; (elim conjE)?, unfold 𝔉'_def)
from σ show "ntcf_arrow σ : cf_map 𝔉 ↦⇘cat_FUNCT α ℭ 𝔄⇙ ?𝔊"
by (cs_concl cs_intro: cat_FUNCT_cs_intros)
from αβ assms(1-3) σ ε'(1) show
"ε' = umap_fo
?𝔄𝔎 ?𝔗 ?𝔊 (ntcf_arrow ε) (cf_map 𝔉)⦇ArrVal⦈⦇ntcf_arrow σ⦈"
by (subst ε')
(
cs_concl
cs_simp:
ε'_def'[symmetric] cat_cs_simps cat_FUNCT_cs_simps cat_Kan_cs_simps
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_Kan_cs_intros
cat_FUNCT_cs_intros
)
fix σ' assume prems:
"σ' : cf_map 𝔉 ↦⇘cat_FUNCT α ℭ 𝔄⇙ ?𝔊"
"ε' = umap_fo ?𝔄𝔎 ?𝔗 ?𝔊 (ntcf_arrow ε) (cf_map 𝔉)⦇ArrVal⦈⦇σ'⦈"
note σ' = cat_FUNCT_is_arrD[OF prems(1)]
from σ'(1) 𝔉 have "ntcf_of_ntcf_arrow ℭ 𝔄 σ' : 𝔉 ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ 𝔄"
by (cs_prems cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
moreover from prems(2) prems(1) αβ assms(1-3) this ε'(1) have
"ntcf_of_ntcf_arrow 𝔅 𝔄 ε' =
ε ∙⇩N⇩T⇩C⇩F (ntcf_of_ntcf_arrow ℭ 𝔄 σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
by (subst (asm) ε'(2))
(
cs_prems
cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps cat_cs_simps
cs_intro:
cat_Kan_cs_intros
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
)
ultimately have σ_def: "σ = ntcf_of_ntcf_arrow ℭ 𝔄 σ'"
by (rule unique_σ[symmetric])
show "σ' = ntcf_arrow σ"
by (subst σ'(2), use nothing in ‹subst σ_def›)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
qed
qed
lemma is_cat_lKeI':
assumes "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔄"
and "η : 𝔗 ↦⇩C⇩F 𝔉 ∘⇩C⇩F 𝔎 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "⋀𝔉' η'.
⟦ 𝔉' : ℭ ↦↦⇩C⇘α⇙ 𝔄; η' : 𝔗 ↦⇩C⇩F 𝔉' ∘⇩C⇩F 𝔎 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄 ⟧ ⟹
∃!σ. σ : 𝔉 ↦⇩C⇩F 𝔉' : ℭ ↦↦⇩C⇘α⇙ 𝔄 ∧ η' = (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎) ∙⇩N⇩T⇩C⇩F η"
shows "η : 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ 𝔉 ∘⇩C⇩F 𝔎 : 𝔅 ↦⇩C ℭ ↦⇩C 𝔄"
proof-
interpret 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔉: is_functor α ℭ 𝔄 𝔉 by (rule assms(2))
interpret η: is_ntcf α 𝔅 𝔄 𝔗 ‹𝔉 ∘⇩C⇩F 𝔎› η by (rule assms(3))
have
"∃!σ.
σ : 𝔊' ↦⇩C⇩F op_cf 𝔉 : op_cat ℭ ↦↦⇩C⇘α⇙ op_cat 𝔄 ∧
η' = op_ntcf η ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F op_cf 𝔎)"
if "𝔊' : op_cat ℭ ↦↦⇩C⇘α⇙ op_cat 𝔄"
and "η' : 𝔊' ∘⇩C⇩F op_cf 𝔎 ↦⇩C⇩F op_cf 𝔗 : op_cat 𝔅 ↦↦⇩C⇘α⇙ op_cat 𝔄"
for 𝔊' η'
proof-
interpret 𝔊': is_functor α ‹op_cat ℭ› ‹op_cat 𝔄› 𝔊' by (rule that(1))
interpret η':
is_ntcf α ‹op_cat 𝔅› ‹op_cat 𝔄› ‹𝔊' ∘⇩C⇩F op_cf 𝔎› ‹op_cf 𝔗› η'
by (rule that(2))
from assms(4)[
OF is_functor.is_functor_op[OF that(1), unfolded cat_op_simps],
OF is_ntcf.is_ntcf_op[OF that(2), unfolded cat_op_simps]
]
obtain σ where σ: "σ : 𝔉 ↦⇩C⇩F op_cf 𝔊' : ℭ ↦↦⇩C⇘α⇙ 𝔄"
and op_η'_def: "op_ntcf η' = σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎 ∙⇩N⇩T⇩C⇩F η"
and unique_σ':
"⟦
σ' : 𝔉 ↦⇩C⇩F op_cf 𝔊' : ℭ ↦↦⇩C⇘α⇙ 𝔄;
op_ntcf η' = σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎 ∙⇩N⇩T⇩C⇩F η
⟧ ⟹ σ' = σ"
for σ'
by metis
interpret σ: is_ntcf α ℭ 𝔄 𝔉 ‹op_cf 𝔊'› σ by (rule σ)
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
show "op_ntcf σ : 𝔊' ↦⇩C⇩F op_cf 𝔉 : op_cat ℭ ↦↦⇩C⇘α⇙ op_cat 𝔄"
by (rule σ.is_ntcf_op[unfolded cat_op_simps])
from op_η'_def have "op_ntcf (op_ntcf η') = op_ntcf (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎 ∙⇩N⇩T⇩C⇩F η)"
by simp
from this σ assms(1-3) show η'_def:
"η' = op_ntcf η ∙⇩N⇩T⇩C⇩F (op_ntcf σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F op_cf 𝔎)"
by (cs_prems cs_simp: cat_op_simps cs_intro: cat_cs_intros)
fix σ' assume prems:
"σ' : 𝔊' ↦⇩C⇩F op_cf 𝔉 : op_cat ℭ ↦↦⇩C⇘α⇙ op_cat 𝔄"
"η' = op_ntcf η ∙⇩N⇩T⇩C⇩F (σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F op_cf 𝔎)"
interpret σ': is_ntcf α ‹op_cat ℭ› ‹op_cat 𝔄› 𝔊' ‹op_cf 𝔉› σ'
by (rule prems(1))
from prems(2) have
"op_ntcf η' = op_ntcf (op_ntcf η ∙⇩N⇩T⇩C⇩F (σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F op_cf 𝔎))"
by simp
also have "… = op_ntcf σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎 ∙⇩N⇩T⇩C⇩F η"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
finally have "op_ntcf η' = op_ntcf σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎 ∙⇩N⇩T⇩C⇩F η" by simp
from unique_σ'[OF σ'.is_ntcf_op[unfolded cat_op_simps] this] show
"σ' = op_ntcf σ"
by (auto simp: cat_op_simps)
qed
qed
from
is_cat_rKeI'
[
OF 𝔎.is_functor_op 𝔉.is_functor_op η.is_ntcf_op[unfolded cat_op_simps],
unfolded cat_op_simps,
OF this
]
interpret η: is_cat_rKe
α
‹op_cat 𝔅›
‹op_cat ℭ›
‹op_cat 𝔄›
‹op_cf 𝔎›
‹op_cf 𝔗›
‹op_cf 𝔉›
‹op_ntcf η›
by simp
show "η : 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ 𝔉 ∘⇩C⇩F 𝔎 : 𝔅 ↦⇩C ℭ ↦⇩C 𝔄"
by (rule η.is_cat_lKe_op[unfolded cat_op_simps])
qed
lemma (in is_cat_rKe) cat_rKe_unique:
assumes "𝔊' : ℭ ↦↦⇩C⇘α⇙ 𝔄" and "ε' : 𝔊' ∘⇩C⇩F 𝔎 ↦⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
shows "∃!σ. σ : 𝔊' ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ 𝔄 ∧ ε' = ε ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
proof-
interpret 𝔊': is_functor α ℭ 𝔄 𝔊' by (rule assms(1))
interpret ε': is_ntcf α 𝔅 𝔄 ‹𝔊' ∘⇩C⇩F 𝔎› 𝔗 ε' by (rule assms(2))
let ?𝔗 = ‹cf_map 𝔗›
and ?𝔊 = ‹cf_map 𝔊›
and ?𝔊' = ‹cf_map 𝔊'›
and ?ε = ‹ntcf_arrow ε›
and ?ε' = ‹ntcf_arrow ε'›
define β where "β = α + ω"
have "𝒵 β" and αβ: "α ∈⇩∘ β"
by (simp_all add: β_def AG.𝒵_Limit_αω AG.𝒵_ω_αω 𝒵_def AG.𝒵_α_αω)
then interpret β: 𝒵 β by simp
interpret 𝔄𝔎: is_tiny_functor
β ‹cat_FUNCT α ℭ 𝔄› ‹cat_FUNCT α 𝔅 𝔄› ‹exp_cat_cf α 𝔄 𝔎›
by (rule cat_rKe_exp_cat_cf_cat_FUNCT_is_arr[OF β.𝒵_axioms αβ])
from assms(1) have 𝔊': "?𝔊' ∈⇩∘ cat_FUNCT α ℭ 𝔄⦇Obj⦈"
by (cs_concl cs_simp: cat_FUNCT_components(1) cs_intro: cat_FUNCT_cs_intros)
with assms(2) have
"?ε' : exp_cat_cf α 𝔄 𝔎⦇ObjMap⦈⦇?𝔊'⦈ ↦⇘cat_FUNCT α 𝔅 𝔄⇙ ?𝔗"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
from
is_functor.universal_arrow_foD(3)[
OF 𝔄𝔎.is_functor_axioms cat_rKe_ua_fo 𝔊' this
]
obtain f' where f': "f' : cf_map 𝔊' ↦⇘cat_FUNCT α ℭ 𝔄⇙ cf_map 𝔊"
and ε'_def: "?ε' = umap_fo (exp_cat_cf α 𝔄 𝔎) ?𝔗 ?𝔊 ?ε ?𝔊'⦇ArrVal⦈⦇f'⦈"
and f'_unique:
"⟦
f'' : ?𝔊' ↦⇘cat_FUNCT α ℭ 𝔄⇙ ?𝔊;
ntcf_arrow ε' = umap_fo (exp_cat_cf α 𝔄 𝔎) ?𝔗 ?𝔊 ?ε ?𝔊'⦇ArrVal⦈⦇f''⦈
⟧ ⟹ f'' = f'"
for f''
by metis
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
from ε'_def cat_FUNCT_is_arrD(1)[OF f'] show
"ε' = ε ∙⇩N⇩T⇩C⇩F (ntcf_of_ntcf_arrow ℭ 𝔄 f' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
by (subst (asm) cat_FUNCT_is_arrD(2)[OF f'])
(
cs_prems
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
from cat_FUNCT_is_arrD(1)[OF f'] show f'_is_arr:
"ntcf_of_ntcf_arrow ℭ 𝔄 f' : 𝔊' ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ 𝔄"
by (cs_prems cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
fix σ assume prems:
"σ : 𝔊' ↦⇩C⇩F 𝔊 : ℭ ↦↦⇩C⇘α⇙ 𝔄" "ε' = ε ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
interpret σ: is_ntcf α ℭ 𝔄 𝔊' 𝔊 σ by (rule prems(1))
from prems(1) have σ:
"ntcf_arrow σ : cf_map 𝔊' ↦⇘cat_FUNCT α ℭ 𝔄⇙ cf_map 𝔊"
by (cs_concl cs_intro: cat_FUNCT_cs_intros)
from prems have ε'_def: "ntcf_arrow ε' =
umap_fo (exp_cat_cf α 𝔄 𝔎) ?𝔗 ?𝔊 ?ε ?𝔊'⦇ArrVal⦈⦇ntcf_arrow σ⦈"
by
(
cs_concl
cs_simp: prems(2) cat_Kan_cs_simps cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
show "σ = ntcf_of_ntcf_arrow ℭ 𝔄 f'"
unfolding f'_unique[OF σ ε'_def, symmetric]
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
qed
qed
lemma (in is_cat_lKe) cat_lKe_unique:
assumes "𝔉' : ℭ ↦↦⇩C⇘α⇙ 𝔄" and "η' : 𝔗 ↦⇩C⇩F 𝔉' ∘⇩C⇩F 𝔎 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
shows "∃!σ. σ : 𝔉 ↦⇩C⇩F 𝔉' : ℭ ↦↦⇩C⇘α⇙ 𝔄 ∧ η' = (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎) ∙⇩N⇩T⇩C⇩F η"
proof-
interpret 𝔉': is_functor α ℭ 𝔄 𝔉' by (rule assms(1))
interpret η': is_ntcf α 𝔅 𝔄 𝔗 ‹𝔉' ∘⇩C⇩F 𝔎› η' by (rule assms(2))
interpret η: is_cat_rKe
α ‹op_cat 𝔅› ‹op_cat ℭ› ‹op_cat 𝔄› ‹op_cf 𝔎› ‹op_cf 𝔗› ‹op_cf 𝔉› ‹op_ntcf η›
by (rule is_cat_rKe_op)
from η.cat_rKe_unique[OF 𝔉'.is_functor_op η'.is_ntcf_op[unfolded cat_op_simps]]
obtain σ where σ: "σ : op_cf 𝔉' ↦⇩C⇩F op_cf 𝔉 : op_cat ℭ ↦↦⇩C⇘α⇙ op_cat 𝔄"
and η'_def: "op_ntcf η' = op_ntcf η ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F op_cf 𝔎)"
and unique_σ': "⋀σ'.
⟦
σ' : op_cf 𝔉' ↦⇩C⇩F op_cf 𝔉 : op_cat ℭ ↦↦⇩C⇘α⇙ op_cat 𝔄;
op_ntcf η' = op_ntcf η ∙⇩N⇩T⇩C⇩F (σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F op_cf 𝔎)
⟧ ⟹ σ' = σ"
by metis
interpret σ: is_ntcf α ‹op_cat ℭ› ‹op_cat 𝔄› ‹op_cf 𝔉'› ‹op_cf 𝔉› σ
by (rule σ)
show ?thesis
proof(intro ex1I conjI; (elim conjE)?)
show "op_ntcf σ : 𝔉 ↦⇩C⇩F 𝔉' : ℭ ↦↦⇩C⇘α⇙ 𝔄"
by (rule σ.is_ntcf_op[unfolded cat_op_simps])
have "η' = op_ntcf (op_ntcf η')" by (cs_concl cs_simp: cat_op_simps)
also from η'_def have "… = op_ntcf (op_ntcf η ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F op_cf 𝔎))"
by simp
also have "… = op_ntcf σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎 ∙⇩N⇩T⇩C⇩F η"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
finally show "η' = op_ntcf σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎 ∙⇩N⇩T⇩C⇩F η" by simp
fix σ' assume prems:
"σ' : 𝔉 ↦⇩C⇩F 𝔉' : ℭ ↦↦⇩C⇘α⇙ 𝔄"
"η' = σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎 ∙⇩N⇩T⇩C⇩F η"
interpret σ': is_ntcf α ℭ 𝔄 𝔉 𝔉' σ' by (rule prems(1))
from prems(2) have "op_ntcf η' = op_ntcf (σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎 ∙⇩N⇩T⇩C⇩F η)"
by simp
also have "… = op_ntcf η ∙⇩N⇩T⇩C⇩F (op_ntcf σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F op_cf 𝔎)"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
finally have "op_ntcf η' = op_ntcf η ∙⇩N⇩T⇩C⇩F (op_ntcf σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F op_cf 𝔎)"
by simp
from unique_σ'[OF σ'.is_ntcf_op this] show "σ' = op_ntcf σ"
by (auto simp: cat_op_simps)
qed
qed
subsubsection‹Further properties›
lemma (in is_cat_rKe) cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows
"ntcf_ua_fo β (exp_cat_cf α 𝔄 𝔎) (cf_map 𝔗) (cf_map 𝔊) (ntcf_arrow ε) :
Hom⇩O⇩.⇩C⇘β⇙cat_FUNCT α ℭ 𝔄(-,cf_map 𝔊) ↦⇩C⇩F⇩.⇩i⇩s⇩o
Hom⇩O⇩.⇩C⇘β⇙cat_FUNCT α 𝔅 𝔄(-,cf_map 𝔗) ∘⇩C⇩F op_cf (exp_cat_cf α 𝔄 𝔎) :
op_cat (cat_FUNCT α ℭ 𝔄) ↦↦⇩C⇘β⇙ cat_Set β"
proof-
interpret 𝔄_𝔎:
is_tiny_functor β ‹cat_FUNCT α ℭ 𝔄› ‹cat_FUNCT α 𝔅 𝔄› ‹exp_cat_cf α 𝔄 𝔎›
by
(
rule exp_cat_cf_is_tiny_functor[
OF assms Ran.HomCod.category_axioms AG.is_functor_axioms
]
)
show ?thesis
by
(
rule is_functor.cf_ntcf_ua_fo_is_iso_ntcf[
OF 𝔄_𝔎.is_functor_axioms cat_rKe_ua_fo
]
)
qed
lemma (in is_cat_lKe) cat_lKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit:
assumes "𝒵 β" and "α ∈⇩∘ β"
defines "𝔄𝔎 ≡ exp_cat_cf α (op_cat 𝔄) (op_cf 𝔎)"
and "𝔄ℭ ≡ cat_FUNCT α (op_cat ℭ) (op_cat 𝔄)"
and "𝔄𝔅 ≡ cat_FUNCT α (op_cat 𝔅) (op_cat 𝔄)"
shows
"ntcf_ua_fo β 𝔄𝔎 (cf_map 𝔗) (cf_map 𝔉) (ntcf_arrow (op_ntcf η)) :
Hom⇩O⇩.⇩C⇘β⇙𝔄ℭ(-,cf_map 𝔉) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘β⇙𝔄𝔅(-,cf_map 𝔗) ∘⇩C⇩F op_cf 𝔄𝔎 :
op_cat 𝔄ℭ ↦↦⇩C⇘β⇙ cat_Set β"
proof-
note simps = 𝔄ℭ_def 𝔄𝔅_def 𝔄𝔎_def
interpret 𝔄_𝔎: is_tiny_functor β 𝔄ℭ 𝔄𝔅 𝔄𝔎
unfolding simps
by
(
rule exp_cat_cf_is_tiny_functor[
OF assms(1,2) Lan.HomCod.category_op AG.is_functor_op
]
)
show ?thesis
unfolding simps
by
(
rule is_functor.cf_ntcf_ua_fo_is_iso_ntcf[
OF 𝔄_𝔎.is_functor_axioms[unfolded simps] cat_lKe_ua_fo
]
)
qed
subsection‹The Kan extension›
text‹
The following subsection is based on the statement and proof of
Theorem 1 in Chapter X-3 in \cite{mac_lane_categories_2010}.
In what follows, only the right Kan extension is considered for simplicity.
›
subsubsection‹Definition and elementary properties›
definition the_cf_rKe :: "V ⇒ V ⇒ V ⇒ (V ⇒ V) ⇒ V"
where "the_cf_rKe α 𝔗 𝔎 lim_Obj =
[
(λc∈⇩∘𝔎⦇HomCod⦈⦇Obj⦈. lim_Obj c⦇UObj⦈),
(
λg∈⇩∘𝔎⦇HomCod⦈⦇Arr⦈. THE f.
f :
lim_Obj (𝔎⦇HomCod⦈⦇Dom⦈⦇g⦈)⦇UObj⦈ ↦⇘𝔗⦇HomCod⦈⇙
lim_Obj (𝔎⦇HomCod⦈⦇Cod⦈⦇g⦈)⦇UObj⦈ ∧
lim_Obj (𝔎⦇HomCod⦈⦇Dom⦈⦇g⦈)⦇UArr⦈ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F g ⇩A↓⇩C⇩F 𝔎 =
lim_Obj (𝔎⦇HomCod⦈⦇Cod⦈⦇g⦈)⦇UArr⦈ ∙⇩N⇩T⇩C⇩F
ntcf_const ((𝔎⦇HomCod⦈⦇Cod⦈⦇g⦈) ↓⇩C⇩F 𝔎) (𝔗⦇HomCod⦈) f
),
𝔎⦇HomCod⦈,
𝔗⦇HomCod⦈
]⇩∘"
definition the_ntcf_rKe :: "V ⇒ V ⇒ V ⇒ (V ⇒ V) ⇒ V"
where "the_ntcf_rKe α 𝔗 𝔎 lim_Obj =
[
(
λc∈⇩∘𝔗⦇HomDom⦈⦇Obj⦈.
lim_Obj (𝔎⦇ObjMap⦈⦇c⦈)⦇UArr⦈⦇NTMap⦈⦇0, c, 𝔎⦇HomCod⦈⦇CId⦈⦇𝔎⦇ObjMap⦈⦇c⦈⦈⦈⇩∙
),
the_cf_rKe α 𝔗 𝔎 lim_Obj ∘⇩C⇩F 𝔎,
𝔗,
𝔗⦇HomDom⦈,
𝔗⦇HomCod⦈
]⇩∘"
text‹Components.›
lemma the_cf_rKe_components:
shows "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ObjMap⦈ =
(λc∈⇩∘𝔎⦇HomCod⦈⦇Obj⦈. lim_Obj c⦇UObj⦈)"
and "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈ =
(
λg∈⇩∘𝔎⦇HomCod⦈⦇Arr⦈. THE f.
f :
lim_Obj (𝔎⦇HomCod⦈⦇Dom⦈⦇g⦈)⦇UObj⦈ ↦⇘𝔗⦇HomCod⦈⇙
lim_Obj (𝔎⦇HomCod⦈⦇Cod⦈⦇g⦈)⦇UObj⦈ ∧
lim_Obj (𝔎⦇HomCod⦈⦇Dom⦈⦇g⦈)⦇UArr⦈ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F g ⇩A↓⇩C⇩F 𝔎 =
lim_Obj (𝔎⦇HomCod⦈⦇Cod⦈⦇g⦈)⦇UArr⦈ ∙⇩N⇩T⇩C⇩F
ntcf_const ((𝔎⦇HomCod⦈⦇Cod⦈⦇g⦈) ↓⇩C⇩F 𝔎) (𝔗⦇HomCod⦈) f
)"
and "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇HomDom⦈ = 𝔎⦇HomCod⦈"
and "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇HomCod⦈ = 𝔗⦇HomCod⦈"
unfolding the_cf_rKe_def dghm_field_simps by (simp_all add: nat_omega_simps)
lemma the_ntcf_rKe_components:
shows "the_ntcf_rKe α 𝔗 𝔎 lim_Obj⦇NTMap⦈ =
(
λc∈⇩∘𝔗⦇HomDom⦈⦇Obj⦈.
lim_Obj (𝔎⦇ObjMap⦈⦇c⦈)⦇UArr⦈⦇NTMap⦈⦇0, c, 𝔎⦇HomCod⦈⦇CId⦈⦇𝔎⦇ObjMap⦈⦇c⦈⦈⦈⇩∙
)"
and "the_ntcf_rKe α 𝔗 𝔎 lim_Obj⦇NTDom⦈ = the_cf_rKe α 𝔗 𝔎 lim_Obj ∘⇩C⇩F 𝔎"
and "the_ntcf_rKe α 𝔗 𝔎 lim_Obj⦇NTCod⦈ = 𝔗"
and "the_ntcf_rKe α 𝔗 𝔎 lim_Obj⦇NTDGDom⦈ = 𝔗⦇HomDom⦈"
and "the_ntcf_rKe α 𝔗 𝔎 lim_Obj⦇NTDGCod⦈ = 𝔗⦇HomCod⦈"
unfolding the_ntcf_rKe_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes α 𝔄 𝔅 ℭ 𝔎 𝔗
assumes 𝔎: "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)
lemmas the_cf_rKe_components' = the_cf_rKe_components[
where 𝔎=𝔎 and 𝔗=𝔗 and α=α, unfolded 𝔎.cf_HomCod 𝔗.cf_HomCod
]
lemmas [cat_Kan_cs_simps] = the_cf_rKe_components'(3,4)
lemmas the_ntcf_rKe_components' = the_ntcf_rKe_components[
where 𝔎=𝔎 and 𝔗=𝔗 and α=α, unfolded 𝔎.cf_HomCod 𝔗.cf_HomCod 𝔗.cf_HomDom
]
lemmas [cat_Kan_cs_simps] = the_ntcf_rKe_components'(2-5)
end
subsubsection‹Functor: object map›
mk_VLambda the_cf_rKe_components(1)
|vsv the_cf_rKe_ObjMap_vsv[cat_Kan_cs_intros]|
context
fixes α 𝔄 𝔅 ℭ 𝔎 𝔗
assumes 𝔎: "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
mk_VLambda the_cf_rKe_components'(1)[OF 𝔎 𝔗]
|vdomain the_cf_rKe_ObjMap_vdomain[cat_Kan_cs_simps]|
|app the_cf_rKe_ObjMap_impl_app[cat_Kan_cs_simps]|
lemma the_cf_rKe_ObjMap_vrange:
assumes "⋀c. c ∈⇩∘ ℭ⦇Obj⦈ ⟹ lim_Obj c⦇UObj⦈ ∈⇩∘ 𝔄⦇Obj⦈"
shows "ℛ⇩∘ (the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ObjMap⦈) ⊆⇩∘ 𝔄⦇Obj⦈"
unfolding the_cf_rKe_components'[OF 𝔎 𝔗]
by (intro vrange_VLambda_vsubset assms)
end
subsubsection‹Functor: arrow map›
mk_VLambda the_cf_rKe_components(2)
|vsv the_cf_rKe_ArrMap_vsv[cat_Kan_cs_intros]|
context
fixes α 𝔅 ℭ 𝔎
assumes 𝔎: "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
begin
interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
mk_VLambda the_cf_rKe_components(2)[where α=α and 𝔎=𝔎, unfolded 𝔎.cf_HomCod]
|vdomain the_cf_rKe_ArrMap_vdomain[cat_Kan_cs_simps]|
context
fixes 𝔄 𝔗 c c' g
assumes 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and g: "g : c ↦⇘ℭ⇙ c'"
begin
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)
lemma g': "g ∈⇩∘ ℭ⦇Arr⦈" using g by auto
mk_VLambda the_cf_rKe_components(2)[
where α=α and 𝔎=𝔎 and 𝔗=𝔗, unfolded 𝔎.cf_HomCod 𝔗.cf_HomCod
]
|app the_cf_rKe_ArrMap_app_impl'|
lemmas the_cf_rKe_ArrMap_app' = the_cf_rKe_ArrMap_app_impl'[
OF g', unfolded 𝔎.HomCod.cat_is_arrD[OF g]
]
end
end
lemma the_cf_rKe_ArrMap_app_impl:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "g : c ↦⇘ℭ⇙ c'"
and "u : r <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and "u' : r' <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎 : c' ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
shows "∃!f.
f : r ↦⇘𝔄⇙ r' ∧
u ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F g ⇩A↓⇩C⇩F 𝔎 = u' ∙⇩N⇩T⇩C⇩F ntcf_const (c' ↓⇩C⇩F 𝔎) 𝔄 f"
proof-
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
interpret u: is_cat_limit α ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› r u
by (rule assms(4))
interpret u': is_cat_limit α ‹c' ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎› r' u'
by (rule assms(5))
have const_r_def:
"cf_const (c' ↓⇩C⇩F 𝔎) 𝔄 r = cf_const (c ↓⇩C⇩F 𝔎) 𝔄 r ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎"
proof(rule cf_eqI)
show const_r: "cf_const (c' ↓⇩C⇩F 𝔎) 𝔄 r : c' ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
from assms(3) show const_r_g𝔎:
"cf_const (c ↓⇩C⇩F 𝔎) 𝔄 r ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎 : c' ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
have ObjMap_dom_lhs: "𝒟⇩∘ (cf_const (c' ↓⇩C⇩F 𝔎) 𝔄 r⦇ObjMap⦈) = c' ↓⇩C⇩F 𝔎⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3) have ObjMap_dom_rhs:
"𝒟⇩∘ ((cf_const (c ↓⇩C⇩F 𝔎) 𝔄 r ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ObjMap⦈) = c' ↓⇩C⇩F 𝔎⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
)
have ArrMap_dom_lhs: "𝒟⇩∘ (cf_const (c' ↓⇩C⇩F 𝔎) 𝔄 r⦇ArrMap⦈) = c' ↓⇩C⇩F 𝔎⦇Arr⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3) have ArrMap_dom_rhs:
"𝒟⇩∘ ((cf_const (c ↓⇩C⇩F 𝔎) 𝔄 r ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ArrMap⦈) = c' ↓⇩C⇩F 𝔎⦇Arr⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
)
show
"cf_const (c' ↓⇩C⇩F 𝔎) 𝔄 r⦇ObjMap⦈ =
(cf_const (c ↓⇩C⇩F 𝔎) 𝔄 r ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ObjMap⦈"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix A assume prems: "A ∈⇩∘ c' ↓⇩C⇩F 𝔎⦇Obj⦈"
from prems assms obtain b f
where A_def: "A = [0, b, f]⇩∘"
and b: "b ∈⇩∘ 𝔅⦇Obj⦈"
and f: "f : c' ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
by auto
from assms(1,3) prems f b show
"cf_const (c' ↓⇩C⇩F 𝔎) 𝔄 r⦇ObjMap⦈⦇A⦈ =
(cf_const (c ↓⇩C⇩F 𝔎) 𝔄 r ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ObjMap⦈⦇A⦈"
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed (use assms(3) in ‹cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros›)+
show
"cf_const (c' ↓⇩C⇩F 𝔎) 𝔄 r⦇ArrMap⦈ =
(cf_const (c ↓⇩C⇩F 𝔎) 𝔄 r ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ArrMap⦈"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
show "vsv (cf_const (c' ↓⇩C⇩F 𝔎) 𝔄 r⦇ArrMap⦈)"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms(3) show "vsv ((cf_const (c ↓⇩C⇩F 𝔎) 𝔄 r ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ArrMap⦈)"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
fix F assume prems: "F ∈⇩∘ c' ↓⇩C⇩F 𝔎⦇Arr⦈"
with prems obtain A B where F: "F : A ↦⇘c' ↓⇩C⇩F 𝔎⇙ B"
by (auto intro: is_arrI)
with assms obtain b f b' f' h'
where F_def: "F = [[0, b, f]⇩∘, [0, b', f']⇩∘, [0, h']⇩∘]⇩∘"
and A_def: "A = [0, b, f]⇩∘"
and B_def: "B = [0, b', f']⇩∘"
and h': "h' : b ↦⇘𝔅⇙ b'"
and f: "f : c' ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
and f': "f' : c' ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
and f'_def: "𝔎⦇ArrMap⦈⦇h'⦈ ∘⇩A⇘ℭ⇙ f = f'"
by auto
from prems assms(3) F g' h' f f' show
"cf_const (c' ↓⇩C⇩F 𝔎) 𝔄 r⦇ArrMap⦈⦇F⦈ =
(cf_const (c ↓⇩C⇩F 𝔎) 𝔄 r ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ArrMap⦈⦇F⦈"
unfolding F_def A_def B_def
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps f'_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed simp
qed simp_all
have 𝔗c'𝔎: "𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎 = 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎"
proof(rule cf_eqI)
show "𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎 : c' ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by (cs_concl cs_intro: cat_cs_intros)
from assms show " 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎 : c' ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_comma_cs_intros cat_cs_intros
)
have ObjMap_dom_lhs: "𝒟⇩∘ ((𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈) = c' ↓⇩C⇩F 𝔎⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms have ObjMap_dom_rhs:
"𝒟⇩∘ ((𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ObjMap⦈) = c' ↓⇩C⇩F 𝔎⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_comma_cs_intros cat_cs_intros
)
show "(𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈ = (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ObjMap⦈"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
from assms show "vsv ((𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈)"
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from assms show "vsv ((𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ObjMap⦈)"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
fix A assume prems: "A ∈⇩∘ c' ↓⇩C⇩F 𝔎⦇Obj⦈"
from assms(3) prems obtain b f
where A_def: "A = [0, b, f]⇩∘"
and b: "b ∈⇩∘ 𝔅⦇Obj⦈"
and f: "f : c' ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
by auto
from prems assms b f show
"(𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇A⦈ =
(𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ObjMap⦈⦇A⦈"
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed simp
have ArrMap_dom_lhs: "𝒟⇩∘ ((𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎)⦇ArrMap⦈) = c' ↓⇩C⇩F 𝔎⦇Arr⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from assms have ArrMap_dom_rhs:
"𝒟⇩∘ ((𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ArrMap⦈) = c' ↓⇩C⇩F 𝔎⦇Arr⦈"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_comma_cs_intros cat_cs_intros
)
show "(𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎)⦇ArrMap⦈ = (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ArrMap⦈"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
from assms show "vsv ((𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎)⦇ArrMap⦈)"
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from assms show "vsv ((𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ArrMap⦈)"
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_comma_cs_intros)
fix F assume prems: "F ∈⇩∘ c' ↓⇩C⇩F 𝔎⦇Arr⦈"
with prems obtain A B where F: "F : A ↦⇘c' ↓⇩C⇩F 𝔎⇙ B"
unfolding cat_comma_cs_simps by (auto intro: is_arrI)
with assms(3) obtain b f b' f' h'
where F_def: "F = [[0, b, f]⇩∘, [0, b', f']⇩∘, [0, h']⇩∘]⇩∘"
and A_def: "A = [0, b, f]⇩∘"
and B_def: "B = [0, b', f']⇩∘"
and h': "h' : b ↦⇘𝔅⇙ b'"
and f: "f : c' ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
and f': "f' : c' ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
and f'_def: "𝔎⦇ArrMap⦈⦇h'⦈ ∘⇩A⇘ℭ⇙ f = f'"
by auto
from prems assms(3) F g' h' f f' show
"(𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎)⦇ArrMap⦈⦇F⦈ =
(𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F g ⇩A↓⇩C⇩F 𝔎)⦇ArrMap⦈⦇F⦈"
unfolding F_def A_def B_def
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps f'_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed simp
qed simp_all
from assms(1-3) have
"u ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F g ⇩A↓⇩C⇩F 𝔎 : r <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎 : c' ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by (intro is_cat_coneI is_tm_ntcfI')
(
cs_concl
cs_intro:
cat_cs_intros
cat_comma_cs_intros
cat_lim_cs_intros
cat_small_cs_intros
cs_simp: const_r_def 𝔗c'𝔎
)+
with u'.cat_lim_unique_cone show
"∃!G.
G : r ↦⇘𝔄⇙ r' ∧
u ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F g ⇩A↓⇩C⇩F 𝔎 = u' ∙⇩N⇩T⇩C⇩F ntcf_const (c' ↓⇩C⇩F 𝔎) 𝔄 G"
by simp
qed
lemma the_cf_rKe_ArrMap_app:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "g : c ↦⇘ℭ⇙ c'"
and "lim_Obj c⦇UArr⦈ :
lim_Obj c⦇UObj⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and "lim_Obj c'⦇UArr⦈ :
lim_Obj c'⦇UObj⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎 : c' ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
shows "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈ :
lim_Obj c⦇UObj⦈ ↦⇘𝔄⇙ lim_Obj c'⦇UObj⦈"
and
"lim_Obj c⦇UArr⦈ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F g ⇩A↓⇩C⇩F 𝔎 =
lim_Obj c'⦇UArr⦈ ∙⇩N⇩T⇩C⇩F
ntcf_const (c' ↓⇩C⇩F 𝔎) 𝔄 (the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈)"
and
"⟦
f : lim_Obj c⦇UObj⦈ ↦⇘𝔄⇙ lim_Obj c'⦇UObj⦈;
lim_Obj c⦇UArr⦈ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F g ⇩A↓⇩C⇩F 𝔎 =
lim_Obj c'⦇UArr⦈ ∙⇩N⇩T⇩C⇩F ntcf_const (c' ↓⇩C⇩F 𝔎) 𝔄 f
⟧ ⟹ f = the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈"
proof-
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
interpret u: is_cat_limit
α ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› ‹lim_Obj c⦇UObj⦈› ‹lim_Obj c⦇UArr⦈›
by (rule assms(4))
interpret u': is_cat_limit
α ‹c' ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎› ‹lim_Obj c'⦇UObj⦈› ‹lim_Obj c'⦇UArr⦈›
by (rule assms(5))
from assms(3) have c: "c ∈⇩∘ ℭ⦇Obj⦈" and c': "c' ∈⇩∘ ℭ⦇Obj⦈" by auto
note the_cf_rKe_ArrMap_app_impl' =
the_cf_rKe_ArrMap_app_impl[OF assms]
note the_f = theI'[OF the_cf_rKe_ArrMap_app_impl[OF assms]]
note the_f_is_arr = the_f[THEN conjunct1]
and the_f_commutes = the_f[THEN conjunct2]
from assms(3) the_f_is_arr show
"the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈ :
lim_Obj c⦇UObj⦈ ↦⇘𝔄⇙ lim_Obj c'⦇UObj⦈"
by (cs_concl cs_simp: the_cf_rKe_ArrMap_app' cs_intro: cat_cs_intros)
moreover from assms(3) the_f_commutes show
"lim_Obj c⦇UArr⦈ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F g ⇩A↓⇩C⇩F 𝔎 =
lim_Obj c'⦇UArr⦈ ∙⇩N⇩T⇩C⇩F
ntcf_const (c' ↓⇩C⇩F 𝔎) 𝔄 (the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈)"
by (cs_concl cs_simp: the_cf_rKe_ArrMap_app' cs_intro: cat_cs_intros)
ultimately show "f = the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈"
if "f : lim_Obj c⦇UObj⦈ ↦⇘𝔄⇙ lim_Obj c'⦇UObj⦈"
and "lim_Obj c⦇UArr⦈ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F g ⇩A↓⇩C⇩F 𝔎 =
lim_Obj c'⦇UArr⦈ ∙⇩N⇩T⇩C⇩F ntcf_const (c' ↓⇩C⇩F 𝔎) 𝔄 f"
by (metis that the_cf_rKe_ArrMap_app_impl')
qed
lemma the_cf_rKe_ArrMap_is_arr'[cat_Kan_cs_intros]:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "g : c ↦⇘ℭ⇙ c'"
and "lim_Obj c⦇UArr⦈ :
lim_Obj c⦇UObj⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and "lim_Obj c'⦇UArr⦈ :
lim_Obj c'⦇UObj⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c' ⇩O⨅⇩C⇩F 𝔎 : c' ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and "a = lim_Obj c⦇UObj⦈"
and "b = lim_Obj c'⦇UObj⦈"
shows "the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇g⦈ : a ↦⇘𝔄⇙ b"
unfolding assms(6,7) by (rule the_cf_rKe_ArrMap_app[OF assms(1-5)])
lemma lim_Obj_the_cf_rKe_commute:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "lim_Obj a⦇UArr⦈ :
lim_Obj a⦇UObj⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F a ⇩O⨅⇩C⇩F 𝔎 : a ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and "lim_Obj b⦇UArr⦈ :
lim_Obj b⦇UObj⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F b ⇩O⨅⇩C⇩F 𝔎 : b ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and "f : a ↦⇘ℭ⇙ b"
and "[a', b', f']⇩∘ ∈⇩∘ b ↓⇩C⇩F 𝔎⦇Obj⦈"
shows
"lim_Obj a⦇UArr⦈⦇NTMap⦈⦇a', b', f' ∘⇩A⇘ℭ⇙ f⦈⇩∙ =
lim_Obj b⦇UArr⦈⦇NTMap⦈⦇a', b', f'⦈⇩∙ ∘⇩A⇘𝔄⇙
the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇f⦈"
proof-
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
note f = 𝔎.HomCod.cat_is_arrD[OF assms(5)]
interpret lim_a: is_cat_limit
α ‹a ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F a ⇩O⨅⇩C⇩F 𝔎› ‹lim_Obj a⦇UObj⦈› ‹lim_Obj a⦇UArr⦈›
by (rule assms(3))
interpret lim_b: is_cat_limit
α ‹b ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F b ⇩O⨅⇩C⇩F 𝔎› ‹lim_Obj b⦇UObj⦈› ‹lim_Obj b⦇UArr⦈›
by (rule assms(4))
note f_app = the_cf_rKe_ArrMap_app[
where lim_Obj=lim_Obj, OF assms(1,2,5,3,4)
]
from f_app(2) have lim_a_f𝔎_NTMap_app:
"(lim_Obj a⦇UArr⦈ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F f ⇩A↓⇩C⇩F 𝔎)⦇NTMap⦈⦇A⦈ =
(
lim_Obj b⦇UArr⦈ ∙⇩N⇩T⇩C⇩F
ntcf_const (b ↓⇩C⇩F 𝔎) 𝔄 (the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇f⦈)
)⦇NTMap⦈⦇A⦈"
if ‹A ∈⇩∘ b ↓⇩C⇩F 𝔎⦇Obj⦈› for A
by simp
show
"lim_Obj a⦇UArr⦈⦇NTMap⦈⦇a', b', f' ∘⇩A⇘ℭ⇙ f⦈⇩∙ =
lim_Obj b⦇UArr⦈⦇NTMap⦈⦇a', b', f'⦈⇩∙ ∘⇩A⇘𝔄⇙
the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇f⦈"
proof-
from assms(5,6) have a'_def: "a' = 0"
and b': "b' ∈⇩∘ 𝔅⦇Obj⦈"
and f': "f' : b ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
by auto
show
"lim_Obj a⦇UArr⦈⦇NTMap⦈⦇a', b', f' ∘⇩A⇘ℭ⇙ f⦈⇩∙ =
lim_Obj b⦇UArr⦈⦇NTMap⦈⦇a', b', f'⦈⇩∙ ∘⇩A⇘𝔄⇙
the_cf_rKe α 𝔗 𝔎 lim_Obj⦇ArrMap⦈⦇f⦈"
using lim_a_f𝔎_NTMap_app[OF assms(6)] f' assms(3,4,5,6)
unfolding a'_def
by
(
cs_prems
cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_comma_cs_intros
cat_Kan_cs_intros
)
qed
qed
subsubsection‹Natural transformation: natural transformation map›
mk_VLambda the_ntcf_rKe_components(1)
|vsv the_ntcf_rKe_NTMap_vsv[cat_Kan_cs_intros]|
context
fixes α 𝔄 𝔅 ℭ 𝔎 𝔗
assumes 𝔎: "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)
mk_VLambda the_ntcf_rKe_components'(1)[OF 𝔎 𝔗]
|vdomain the_ntcf_rKe_ObjMap_vdomain[cat_Kan_cs_simps]|
|app the_ntcf_rKe_ObjMap_impl_app[cat_Kan_cs_simps]|
end
subsubsection‹The Kan extension is a Kan extension›
lemma the_cf_rKe_is_functor:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "⋀c. c ∈⇩∘ ℭ⦇Obj⦈ ⟹ lim_Obj c⦇UArr⦈ :
lim_Obj c⦇UObj⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
shows "the_cf_rKe α 𝔗 𝔎 lim_Obj : ℭ ↦↦⇩C⇘α⇙ 𝔄"
proof-
let ?UObj = ‹λa. lim_Obj a⦇UObj⦈›
let ?UArr = ‹λa. lim_Obj a⦇UArr⦈›
let ?const_comma = ‹λa b. cf_const (a ↓⇩C⇩F 𝔎) 𝔄 (?UObj b)›
let ?the_cf_rKe = ‹the_cf_rKe α 𝔗 𝔎 lim_Obj›
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
note [cat_lim_cs_intros] = is_cat_cone.cat_cone_obj
show ?thesis
proof(intro is_functorI')
show "vfsequence ?the_cf_rKe" unfolding the_cf_rKe_def by simp
show "vcard ?the_cf_rKe = 4⇩ℕ"
unfolding the_cf_rKe_def by (simp add: nat_omega_simps)
show "vsv (?the_cf_rKe⦇ObjMap⦈)" by (cs_concl cs_intro: cat_Kan_cs_intros)
moreover show "𝒟⇩∘ (?the_cf_rKe⦇ObjMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
moreover show "ℛ⇩∘ (?the_cf_rKe⦇ObjMap⦈) ⊆⇩∘ 𝔄⦇Obj⦈"
proof
(
intro the_cf_rKe_ObjMap_vrange;
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)?
)
fix c assume "c ∈⇩∘ ℭ⦇Obj⦈"
with assms(3)[OF this] show "?UObj c ∈⇩∘ 𝔄⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros)
qed
ultimately have [cat_Kan_cs_intros]:
"?the_cf_rKe⦇ObjMap⦈⦇c⦈ ∈⇩∘ 𝔄⦇Obj⦈" if ‹c ∈⇩∘ ℭ⦇Obj⦈› for c
by (metis that vsubsetE vsv.vsv_value)
show "?the_cf_rKe⦇ArrMap⦈⦇f⦈ :
?the_cf_rKe⦇ObjMap⦈⦇a⦈ ↦⇘𝔄⇙ ?the_cf_rKe⦇ObjMap⦈⦇b⦈"
if "f : a ↦⇘ℭ⇙ b" for a b f
using assms(2) that
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro:
assms(3) cat_small_cs_intros cat_cs_intros cat_Kan_cs_intros
)
then have [cat_Kan_cs_intros]: "?the_cf_rKe⦇ArrMap⦈⦇f⦈ : A ↦⇘𝔄⇙ B"
if "A = ?the_cf_rKe⦇ObjMap⦈⦇a⦈"
and "B = ?the_cf_rKe⦇ObjMap⦈⦇b⦈"
and "f : a ↦⇘ℭ⇙ b"
for A B a b f
by (simp add: that)
show
"?the_cf_rKe⦇ArrMap⦈⦇g ∘⇩A⇘ℭ⇙ f⦈ =
?the_cf_rKe⦇ArrMap⦈⦇g⦈ ∘⇩A⇘𝔄⇙ ?the_cf_rKe⦇ArrMap⦈⦇f⦈"
(is ‹?the_cf_rKe⦇ArrMap⦈⦇g ∘⇩A⇘ℭ⇙ f⦈ = ?the_rKe_g ∘⇩A⇘𝔄⇙ ?the_rKe_f›)
if g_is_arr: "g : b ↦⇘ℭ⇙ c" and f_is_arr: "f : a ↦⇘ℭ⇙ b" for b c g a f
proof-
let ?ntcf_const_c = ‹λf. ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 f›
note g = 𝔎.HomCod.cat_is_arrD[OF that(1)]
and f = 𝔎.HomCod.cat_is_arrD[OF that(2)]
note lim_a = assms(3)[OF f(2)]
and lim_b = assms(3)[OF g(2)]
and lim_c = assms(3)[OF g(3)]
from that have gf: "g ∘⇩A⇘ℭ⇙ f : a ↦⇘ℭ⇙ c"
by (cs_concl cs_intro: cat_cs_intros)
interpret lim_a: is_cat_limit
α ‹a ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F a ⇩O⨅⇩C⇩F 𝔎› ‹?UObj a› ‹?UArr a›
by (rule lim_a)
interpret lim_c: is_cat_limit
α ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› ‹?UObj c› ‹?UArr c›
by (rule lim_c)
show ?thesis
proof
(
rule sym,
rule the_cf_rKe_ArrMap_app(3)[OF assms(1,2) gf lim_a lim_c]
)
from assms(1,2) that lim_a lim_b lim_c show
"?the_rKe_g ∘⇩A⇘𝔄⇙ ?the_rKe_f : ?UObj a ↦⇘𝔄⇙ ?UObj c"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)
show
"?UArr a ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎 =
?UArr c ∙⇩N⇩T⇩C⇩F ?ntcf_const_c (?the_rKe_g ∘⇩A⇘𝔄⇙ ?the_rKe_f)"
(
is
‹
?UArr a ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎 =
?UArr c ∙⇩N⇩T⇩C⇩F ?ntcf_const_c ?the_rKe_gf
›
)
proof(rule ntcf_eqI)
from that show
"?UArr a ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎 :
cf_const (a ↓⇩C⇩F 𝔎) 𝔄 (?UObj a) ∘⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎 ↦⇩C⇩F
𝔗 ∘⇩C⇩F a ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F ((g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎) :
c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
have [cat_comma_cs_simps]:
"?const_comma a a ∘⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎 = ?const_comma c a"
proof(rule cf_eqI)
from g_is_arr f_is_arr show
"?const_comma a a ∘⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
)
from g_is_arr f_is_arr show "?const_comma c a : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
)
from g_is_arr f_is_arr have ObjMap_dom_lhs:
"𝒟⇩∘ ((?const_comma a a ∘⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎)⦇ObjMap⦈) =
c ↓⇩C⇩F 𝔎⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_comma_cs_intros cat_lim_cs_intros cat_cs_intros
)
from g_is_arr f_is_arr have ObjMap_dom_rhs:
"𝒟⇩∘ (?const_comma c a⦇ObjMap⦈) = c ↓⇩C⇩F 𝔎⦇Obj⦈"
by (cs_concl cs_simp: cat_comma_cs_simps cat_cs_simps)
show
"(?const_comma a a ∘⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎)⦇ObjMap⦈ =
?const_comma c a⦇ObjMap⦈"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
from f_is_arr g_is_arr show
"vsv ((?const_comma a a ∘⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎)⦇ObjMap⦈)"
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
)
fix A assume prems: "A ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈"
with g_is_arr obtain b' f'
where A_def: "A = [0, b', f']⇩∘"
and b': "b' ∈⇩∘ 𝔅⦇Obj⦈"
and f': "f' : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
by auto
from prems b' f' g_is_arr f_is_arr show
"(?const_comma a a ∘⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎)⦇ObjMap⦈⦇A⦈ =
?const_comma c a⦇ObjMap⦈⦇A⦈"
unfolding A_def
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros)
from g_is_arr f_is_arr have ArrMap_dom_lhs:
"𝒟⇩∘ ((?const_comma a a ∘⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎)⦇ArrMap⦈) =
c ↓⇩C⇩F 𝔎⦇Arr⦈"
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_comma_cs_intros cat_lim_cs_intros cat_cs_intros
)
from g_is_arr f_is_arr have ArrMap_dom_rhs:
"𝒟⇩∘ (?const_comma c a⦇ArrMap⦈) = c ↓⇩C⇩F 𝔎⦇Arr⦈"
by (cs_concl cs_simp: cat_comma_cs_simps cat_cs_simps)
show
"(?const_comma a a ∘⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎)⦇ArrMap⦈ =
?const_comma c a⦇ArrMap⦈"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
from f_is_arr g_is_arr show
"vsv ((?const_comma a a ∘⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎)⦇ArrMap⦈)"
by
(
cs_concl
cs_simp: cat_comma_cs_simps cat_cs_simps
cs_intro:
cat_cs_intros cat_lim_cs_intros cat_comma_cs_intros
)
fix F assume "F ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Arr⦈"
then obtain A B where F: "F : A ↦⇘c ↓⇩C⇩F 𝔎⇙ B"
unfolding cat_comma_cs_simps by (auto intro: is_arrI)
with g_is_arr obtain b' f' b'' f'' h'
where F_def: "F = [[0, b', f']⇩∘, [0, b'', f'']⇩∘, [0, h']⇩∘]⇩∘"
and A_def: "A = [0, b', f']⇩∘"
and B_def: "B = [0, b'', f'']⇩∘"
and h': "h' : b' ↦⇘𝔅⇙ b''"
and f': "f' : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
and f'': "f'' : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b''⦈"
and f''_def: "𝔎⦇ArrMap⦈⦇h'⦈ ∘⇩A⇘ℭ⇙ f' = f''"
by auto
from F f_is_arr g_is_arr g' h' f' f'' show
"(?const_comma a a ∘⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎)⦇ArrMap⦈⦇F⦈ =
?const_comma c a⦇ArrMap⦈⦇F⦈"
unfolding F_def A_def B_def
by
(
cs_concl
cs_intro:
cat_lim_cs_intros cat_cs_intros cat_comma_cs_intros
cs_simp:
cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
)
qed (cs_concl cs_intro: cat_cs_intros)
qed simp_all
from that show
"?UArr c ∙⇩N⇩T⇩C⇩F ?ntcf_const_c ?the_rKe_gf :
cf_const (a ↓⇩C⇩F 𝔎) 𝔄 (?UObj a) ∘⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎 ↦⇩C⇩F
𝔗 ∘⇩C⇩F a ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F ((g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎) :
c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_comma_cs_simps cat_cs_simps
cs_intro: cat_comma_cs_intros cat_Kan_cs_intros cat_cs_intros
)
from that have dom_lhs:
"𝒟⇩∘ ((?UArr a ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎)⦇NTMap⦈) = c ↓⇩C⇩F 𝔎⦇Obj⦈"
by
(
cs_concl
cs_intro: cat_cs_intros cat_comma_cs_intros
cs_simp: cat_cs_simps cat_comma_cs_simps
)
from that have dom_rhs:
"𝒟⇩∘ ((?UArr c ∙⇩N⇩T⇩C⇩F ?ntcf_const_c ?the_rKe_gf)⦇NTMap⦈) =
c ↓⇩C⇩F 𝔎⦇Obj⦈"
by
(
cs_concl
cs_intro: cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
cs_simp: cat_Kan_cs_simps cat_cs_simps cat_comma_cs_simps
)
show
"(?UArr a ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎)⦇NTMap⦈ =
(?UArr c ∙⇩N⇩T⇩C⇩F ?ntcf_const_c ?the_rKe_gf)⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix A assume prems: "A ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈"
with g_is_arr obtain b' f'
where A_def: "A = [0, b', f']⇩∘"
and b': "b' ∈⇩∘ 𝔅⦇Obj⦈"
and f': "f' : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
by auto
note 𝔗.HomCod.cat_Comp_assoc[cat_cs_simps del]
and 𝔎.HomCod.cat_Comp_assoc[cat_cs_simps del]
and category.cat_Comp_assoc[cat_cs_simps del]
note [symmetric, cat_cs_simps] =
lim_Obj_the_cf_rKe_commute[where lim_Obj=lim_Obj]
𝔎.HomCod.cat_Comp_assoc
𝔗.HomCod.cat_Comp_assoc
from assms(1,2) that prems lim_a lim_b lim_c b' f' show
"(?UArr a ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F (g ∘⇩A⇘ℭ⇙ f) ⇩A↓⇩C⇩F 𝔎)⦇NTMap⦈⦇A⦈ =
(?UArr c ∙⇩N⇩T⇩C⇩F ?ntcf_const_c ?the_rKe_gf)⦇NTMap⦈⦇A⦈"
unfolding A_def
by
(
cs_concl
cs_simp:
cat_cs_simps cat_Kan_cs_simps cat_comma_cs_simps
cs_intro:
cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
)+
qed (cs_concl cs_simp: cs_intro: cat_cs_intros)+
qed simp_all
qed
qed
show "?the_cf_rKe⦇ArrMap⦈⦇ℭ⦇CId⦈⦇c⦈⦈ = 𝔄⦇CId⦈⦇?the_cf_rKe⦇ObjMap⦈⦇c⦈⦈"
if "c ∈⇩∘ ℭ⦇Obj⦈" for c
proof-
let ?ntcf_const_c = ‹ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 (𝔄⦇CId⦈⦇?UObj c⦈)›
note lim_c = assms(3)[OF that]
from that have CId_c: "ℭ⦇CId⦈⦇c⦈ : c ↦⇘ℭ⇙ c"
by (cs_concl cs_intro: cat_cs_intros)
interpret lim_c: is_cat_limit
α ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› ‹?UObj c› ‹?UArr c›
by (rule lim_c)
show ?thesis
proof
(
rule sym,
rule the_cf_rKe_ArrMap_app(3)[
where lim_Obj=lim_Obj, OF assms(1,2) CId_c lim_c lim_c
]
)
from that lim_c show
"𝔄⦇CId⦈⦇?the_cf_rKe⦇ObjMap⦈⦇c⦈⦈ : ?UObj c ↦⇘𝔄⇙ ?UObj c"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_lim_cs_intros
)
have "?UArr c ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F (ℭ⦇CId⦈⦇c⦈) ⇩A↓⇩C⇩F 𝔎 = ?UArr c ∙⇩N⇩T⇩C⇩F ?ntcf_const_c"
proof(rule ntcf_eqI)
from lim_c that show
"?UArr c ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F (ℭ⦇CId⦈⦇c⦈) ⇩A↓⇩C⇩F 𝔎 :
cf_const (c ↓⇩C⇩F 𝔎) 𝔄 (?UObj c) ∘⇩C⇩F (ℭ⦇CId⦈⦇c⦈) ⇩A↓⇩C⇩F 𝔎 ↦⇩C⇩F
𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F (ℭ⦇CId⦈⦇c⦈) ⇩A↓⇩C⇩F 𝔎 :
c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_comma_cs_intros)
from lim_c that show
"?UArr c ∙⇩N⇩T⇩C⇩F ?ntcf_const_c :
cf_const (c ↓⇩C⇩F 𝔎) 𝔄 (?UObj c) ∘⇩C⇩F (ℭ⦇CId⦈⦇c⦈) ⇩A↓⇩C⇩F 𝔎 ↦⇩C⇩F
𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 ∘⇩C⇩F (ℭ⦇CId⦈⦇c⦈) ⇩A↓⇩C⇩F 𝔎 :
c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by
(
cs_concl
cs_intro: cat_cs_intros cat_lim_cs_intros
cs_simp: 𝔎.cf_cf_arr_comma_CId cat_cs_simps
)
from that have dom_lhs:
"𝒟⇩∘ ((?UArr c ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F (ℭ⦇CId⦈⦇c⦈) ⇩A↓⇩C⇩F 𝔎)⦇NTMap⦈) = c ↓⇩C⇩F 𝔎⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from that have dom_rhs:
"𝒟⇩∘ ((?UArr c ∙⇩N⇩T⇩C⇩F ?ntcf_const_c)⦇NTMap⦈) = c ↓⇩C⇩F 𝔎⦇Obj⦈"
by
(
cs_concl
cs_intro: cat_lim_cs_intros cat_cs_intros
cs_simp: cat_cs_simps
)
show
"(?UArr c ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F (ℭ⦇CId⦈⦇c⦈) ⇩A↓⇩C⇩F 𝔎)⦇NTMap⦈ =
(?UArr c ∙⇩N⇩T⇩C⇩F ?ntcf_const_c)⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix A assume prems: "A ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈"
with that obtain b f
where A_def: "A = [0, b, f]⇩∘"
and b: "b ∈⇩∘ 𝔅⦇Obj⦈"
and f: "f : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
by auto
from that prems f have
"?UArr c⦇NTMap⦈⦇0, b, f⦈⇩∙ : ?UObj c ↦⇘𝔄⇙ 𝔗⦇ObjMap⦈⦇b⦈"
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_comma_cs_intros cat_cs_intros
)
from that prems f show
"(?UArr c ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F (ℭ⦇CId⦈⦇c⦈) ⇩A↓⇩C⇩F 𝔎)⦇NTMap⦈⦇A⦈ =
(?UArr c ∙⇩N⇩T⇩C⇩F ?ntcf_const_c)⦇NTMap⦈⦇A⦈"
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro:
cat_lim_cs_intros cat_comma_cs_intros cat_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros)
qed simp_all
with that show
"?UArr c ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F (ℭ⦇CId⦈⦇c⦈) ⇩A↓⇩C⇩F 𝔎 =
?UArr c ∙⇩N⇩T⇩C⇩F ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 (𝔄⦇CId⦈⦇?the_cf_rKe⦇ObjMap⦈⦇c⦈⦈)"
by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
qed
qed
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
lemma the_ntcf_rKe_is_ntcf:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "⋀c. c ∈⇩∘ ℭ⦇Obj⦈ ⟹ lim_Obj c⦇UArr⦈ :
lim_Obj c⦇UObj⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
shows "the_ntcf_rKe α 𝔗 𝔎 lim_Obj :
the_cf_rKe α 𝔗 𝔎 lim_Obj ∘⇩C⇩F 𝔎 ↦⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
proof-
let ?UObj = ‹λa. lim_Obj a⦇UObj⦈›
let ?UArr = ‹λa. lim_Obj a⦇UArr⦈›
let ?const_comma = ‹λa b. cf_const (a ↓⇩C⇩F 𝔎) 𝔄 (?UObj b)›
let ?the_cf_rKe = ‹the_cf_rKe α 𝔗 𝔎 lim_Obj›
let ?the_ntcf_rKe = ‹the_ntcf_rKe α 𝔗 𝔎 lim_Obj›
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
interpret cf_rKe: is_functor α ℭ 𝔄 ‹?the_cf_rKe›
by (rule the_cf_rKe_is_functor[OF assms, simplified])
show ?thesis
proof(rule is_ntcfI')
show "vfsequence ?the_ntcf_rKe" unfolding the_ntcf_rKe_def by simp
show "vcard ?the_ntcf_rKe = 5⇩ℕ"
unfolding the_ntcf_rKe_def by (simp add: nat_omega_simps)
show "?the_ntcf_rKe⦇NTMap⦈⦇b⦈ :
(?the_cf_rKe ∘⇩C⇩F 𝔎)⦇ObjMap⦈⦇b⦈ ↦⇘𝔄⇙ 𝔗⦇ObjMap⦈⦇b⦈"
if "b ∈⇩∘ 𝔅⦇Obj⦈" for b
proof-
let ?𝔎b = ‹𝔎⦇ObjMap⦈⦇b⦈›
from that have 𝔎b: "𝔎⦇ObjMap⦈⦇b⦈ ∈⇩∘ ℭ⦇Obj⦈"
by (cs_concl cs_intro: cat_cs_intros)
note lim_𝔎b = assms(3)[OF 𝔎b]
interpret lim_𝔎b: is_cat_limit
α ‹?𝔎b ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F ?𝔎b ⇩O⨅⇩C⇩F 𝔎› ‹?UObj ?𝔎b› ‹?UArr ?𝔎b›
by (rule lim_𝔎b)
from that lim_𝔎b show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
)+
qed
show
"?the_ntcf_rKe⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ (?the_cf_rKe ∘⇩C⇩F 𝔎)⦇ArrMap⦈⦇f⦈ =
𝔗⦇ArrMap⦈⦇f⦈ ∘⇩A⇘𝔄⇙ ?the_ntcf_rKe⦇NTMap⦈⦇a⦈"
if "f : a ↦⇘𝔅⇙ b" for a b f
proof-
let ?𝔎a = ‹𝔎⦇ObjMap⦈⦇a⦈› and ?𝔎b = ‹𝔎⦇ObjMap⦈⦇b⦈› and ?𝔎f = ‹𝔎⦇ArrMap⦈⦇f⦈›
from that have 𝔎a: "?𝔎a ∈⇩∘ ℭ⦇Obj⦈"
and 𝔎b: "?𝔎b ∈⇩∘ ℭ⦇Obj⦈"
and 𝔎f: "?𝔎f : ?𝔎a ↦⇘ℭ⇙ ?𝔎b"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
note lim_𝔎a = assms(3)[OF 𝔎a]
and lim_𝔎b = assms(3)[OF 𝔎b]
from that have z_b_𝔎b: "[0, b, ℭ⦇CId⦈⦇?𝔎b⦈]⇩∘ ∈⇩∘ ?𝔎b ↓⇩C⇩F 𝔎⦇Obj⦈"
by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
from
lim_Obj_the_cf_rKe_commute[
OF assms(1,2) lim_𝔎a lim_𝔎b 𝔎f z_b_𝔎b, symmetric
]
that
have [cat_Kan_cs_simps]:
"?UArr ?𝔎b⦇NTMap⦈⦇0, b, ℭ⦇CId⦈⦇?𝔎b⦈⦈⇩∙ ∘⇩A⇘𝔄⇙ ?the_cf_rKe⦇ArrMap⦈⦇?𝔎f⦈ =
?UArr ?𝔎a⦇NTMap⦈⦇0, b, ?𝔎f⦈⇩∙"
by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
interpret lim_𝔎a: is_cat_limit
α ‹?𝔎a ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F ?𝔎a ⇩O⨅⇩C⇩F 𝔎› ‹?UObj ?𝔎a› ‹?UArr ?𝔎a›
by (rule lim_𝔎a)
interpret lim_𝔎b: is_cat_limit
α ‹?𝔎b ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F ?𝔎b ⇩O⨅⇩C⇩F 𝔎› ‹?UObj ?𝔎b› ‹?UArr ?𝔎b›
by (rule lim_𝔎b)
from that have
"[[0, a, ℭ⦇CId⦈⦇?𝔎a⦈]⇩∘, [0, b, ?𝔎f]⇩∘, [0, f]⇩∘]⇩∘ :
[0, a, ℭ⦇CId⦈⦇?𝔎a⦈]⇩∘ ↦⇘(?𝔎a) ↓⇩C⇩F 𝔎⇙ [0, b, ?𝔎f]⇩∘"
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from lim_𝔎a.ntcf_Comp_commute[OF this, symmetric] that
have [cat_Kan_cs_simps]:
"𝔗⦇ArrMap⦈⦇f⦈ ∘⇩A⇘𝔄⇙ ?UArr (?𝔎a)⦇NTMap⦈ ⦇0, a, ℭ⦇CId⦈⦇?𝔎a⦈⦈⇩∙ =
?UArr ?𝔎a⦇NTMap⦈⦇0, b, ?𝔎f⦈⇩∙"
by
(
cs_prems
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros 𝒵.cat_1_is_arrI
)
from that show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
)
qed
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
lemma the_ntcf_rKe_is_cat_rKe:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "⋀c. c ∈⇩∘ ℭ⦇Obj⦈ ⟹ lim_Obj c⦇UArr⦈ :
lim_Obj c⦇UObj⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
shows "the_ntcf_rKe α 𝔗 𝔎 lim_Obj :
the_cf_rKe α 𝔗 𝔎 lim_Obj ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 : 𝔅 ↦⇩C ℭ ↦⇩C 𝔄"
proof-
let ?UObj = ‹λa. lim_Obj a⦇UObj⦈›
let ?UArr = ‹λa. lim_Obj a⦇UArr⦈›
let ?the_cf_rKe = ‹the_cf_rKe α 𝔗 𝔎 lim_Obj›
let ?the_ntcf_rKe = ‹the_ntcf_rKe α 𝔗 𝔎 lim_Obj›
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
interpret cf_rKe: is_functor α ℭ 𝔄 ?the_cf_rKe
by (rule the_cf_rKe_is_functor[OF assms, simplified])
interpret ntcf_rKe: is_ntcf α 𝔅 𝔄 ‹?the_cf_rKe ∘⇩C⇩F 𝔎› 𝔗 ?the_ntcf_rKe
by (intro the_ntcf_rKe_is_ntcf assms(3))
(cs_concl cs_intro: cat_cs_intros cat_small_cs_intros)+
show ?thesis
proof(rule is_cat_rKeI')
fix 𝔊 ε assume prems:
"𝔊 : ℭ ↦↦⇩C⇘α⇙ 𝔄" "ε : 𝔊 ∘⇩C⇩F 𝔎 ↦⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
interpret 𝔊: is_functor α ℭ 𝔄 𝔊 by (rule prems(1))
interpret ε: is_ntcf α 𝔅 𝔄 ‹𝔊 ∘⇩C⇩F 𝔎› 𝔗 ε by (rule prems(2))
define ε' where "ε' c =
[
(λA∈⇩∘c ↓⇩C⇩F 𝔎⦇Obj⦈. ε⦇NTMap⦈⦇A⦇1⇩ℕ⦈⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇A⦇2⇩ℕ⦈⦈),
cf_const (c ↓⇩C⇩F 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇c⦈),
𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎,
c ↓⇩C⇩F 𝔎,
𝔄
]⇩∘"
for c
have ε'_components:
"ε' c⦇NTMap⦈ = (λA∈⇩∘c ↓⇩C⇩F 𝔎⦇Obj⦈. ε⦇NTMap⦈⦇A⦇1⇩ℕ⦈⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇A⦇2⇩ℕ⦈⦈)"
"ε' c⦇NTDom⦈ = cf_const (c ↓⇩C⇩F 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇c⦈)"
"ε' c⦇NTCod⦈ = 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎"
"ε' c⦇NTDGDom⦈ = c ↓⇩C⇩F 𝔎"
"ε' c⦇NTDGCod⦈ = 𝔄"
for c
unfolding ε'_def nt_field_simps by (simp_all add: nat_omega_simps)
note [cat_Kan_cs_simps] = ε'_components(2-5)
have [cat_Kan_cs_simps]: "ε' c⦇NTMap⦈⦇A⦈ = ε⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇f⦈"
if "A = [a, b, f]⇩∘" and "[a, b, f]⇩∘ ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈" for A a b c f
using that unfolding ε'_components by (auto simp: nat_omega_simps)
have ε': "ε' c : 𝔊⦇ObjMap⦈⦇c⦈ <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and ε'_unique: "∃!f'.
f' : 𝔊⦇ObjMap⦈⦇c⦈ ↦⇘𝔄⇙ ?UObj c ∧
ε' c = ?UArr c ∙⇩N⇩T⇩C⇩F ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 f'"
if c: "c ∈⇩∘ ℭ⦇Obj⦈" for c
proof-
from that have "?the_cf_rKe⦇ObjMap⦈⦇c⦈ = ?UObj c"
by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
interpret lim_c: is_cat_limit
α ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› ‹?UObj c› ‹?UArr c›
by (rule assms(3)[OF that])
show "ε' c : 𝔊⦇ObjMap⦈⦇c⦈ <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
show "vfsequence (ε' c)" unfolding ε'_def by simp
show "vcard (ε' c) = 5⇩ℕ" unfolding ε'_def by (simp add: nat_omega_simps)
show "vsv (ε' c⦇NTMap⦈)" unfolding ε'_components by simp
show "𝒟⇩∘ (ε' c⦇NTMap⦈) = c ↓⇩C⇩F 𝔎⦇Obj⦈" unfolding ε'_components by simp
show "ε' c⦇NTMap⦈⦇A⦈ :
cf_const (c ↓⇩C⇩F 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇c⦈)⦇ObjMap⦈⦇A⦈ ↦⇘𝔄⇙
(𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇A⦈"
if "A ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈" for A
proof-
from that prems c obtain b f
where A_def: "A = [0, b, f]⇩∘"
and b: "b ∈⇩∘ 𝔅⦇Obj⦈"
and f: "f : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
by auto
from that prems f c that b f show ?thesis
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
show
"ε' c⦇NTMap⦈⦇B⦈ ∘⇩A⇘𝔄⇙ cf_const (c ↓⇩C⇩F 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇c⦈)⦇ArrMap⦈⦇F⦈ =
(𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ArrMap⦈⦇F⦈ ∘⇩A⇘𝔄⇙ ε' c⦇NTMap⦈⦇A⦈"
if "F : A ↦⇘c ↓⇩C⇩F 𝔎⇙ B" for A B F
proof-
from that c
obtain b f b' f' k
where F_def: "F = [[0, b, f]⇩∘, [0, b', f']⇩∘, [0, k]⇩∘]⇩∘"
and A_def: "A = [0, b, f]⇩∘"
and B_def: "B = [0, b', f']⇩∘"
and k: "k : b ↦⇘𝔅⇙ b'"
and f: "f : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
and f': "f' : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
and f'_def: "𝔎⦇ArrMap⦈⦇k⦈ ∘⇩A⇘ℭ⇙ f = f'"
by auto
from c that k f f' show ?thesis
unfolding F_def A_def B_def
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_comma_cs_simps
cat_Kan_cs_simps
ε.ntcf_Comp_commute''
f'_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
qed
(
use c that in
‹
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros
›
)+
from is_cat_limit.cat_lim_unique_cone[OF assms(3)[OF that] this] show
"∃!f'.
f' : 𝔊⦇ObjMap⦈⦇c⦈ ↦⇘𝔄⇙ ?UObj c ∧
ε' c = ?UArr c ∙⇩N⇩T⇩C⇩F ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 f'"
by simp
qed
define σ :: V where
"σ =
[
(
λc∈⇩∘ℭ⦇Obj⦈. THE f.
f : 𝔊⦇ObjMap⦈⦇c⦈ ↦⇘𝔄⇙ ?UObj c ∧
ε' c = ?UArr c ∙⇩N⇩T⇩C⇩F ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 f
),
𝔊,
?the_cf_rKe,
ℭ,
𝔄
]⇩∘"
have σ_components:
"σ⦇NTMap⦈ =
(
λc∈⇩∘ℭ⦇Obj⦈. THE f.
f : 𝔊⦇ObjMap⦈⦇c⦈ ↦⇘𝔄⇙ ?UObj c ∧
ε' c = ?UArr c ∙⇩N⇩T⇩C⇩F ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 f
)"
"σ⦇NTDom⦈ = 𝔊"
"σ⦇NTCod⦈ = ?the_cf_rKe"
"σ⦇NTDGDom⦈ = ℭ"
"σ⦇NTDGCod⦈ = 𝔄"
unfolding σ_def nt_field_simps by (simp_all add: nat_omega_simps)
note [cat_Kan_cs_simps] = σ_components(2-5)
have σ_NTMap_app_def: "σ⦇NTMap⦈⦇c⦈ =
(
THE f.
f : 𝔊⦇ObjMap⦈⦇c⦈ ↦⇘𝔄⇙ ?UObj c ∧
ε' c = ?UArr c ∙⇩N⇩T⇩C⇩F ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 f
)"
if "c ∈⇩∘ ℭ⦇Obj⦈" for c
using that unfolding σ_components by simp
have σ_NTMap_app_is_arr: "σ⦇NTMap⦈⦇c⦈ : 𝔊⦇ObjMap⦈⦇c⦈ ↦⇘𝔄⇙ ?UObj c"
and ε'_σ_commute:
"ε' c = ?UArr c ∙⇩N⇩T⇩C⇩F ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 (σ⦇NTMap⦈⦇c⦈)"
and σ_NTMap_app_unique:
"⟦
f : 𝔊⦇ObjMap⦈⦇c⦈ ↦⇘𝔄⇙ ?UObj c;
ε' c = ?UArr c ∙⇩N⇩T⇩C⇩F ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 f
⟧ ⟹ f = σ⦇NTMap⦈⦇c⦈"
if c: "c ∈⇩∘ ℭ⦇Obj⦈" for c f
proof-
have
"σ⦇NTMap⦈⦇c⦈ : 𝔊⦇ObjMap⦈⦇c⦈ ↦⇘𝔄⇙ ?UObj c ∧
ε' c = ?UArr c ∙⇩N⇩T⇩C⇩F ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 (σ⦇NTMap⦈⦇c⦈)"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps σ_NTMap_app_def
cs_intro: theI' ε'_unique that
)
then show "σ⦇NTMap⦈⦇c⦈ : 𝔊⦇ObjMap⦈⦇c⦈ ↦⇘𝔄⇙ ?UObj c"
and "ε' c = ?UArr c ∙⇩N⇩T⇩C⇩F ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 (σ⦇NTMap⦈⦇c⦈)"
by simp_all
with c ε'_unique[OF c] show "f = σ⦇NTMap⦈⦇c⦈"
if "f : 𝔊⦇ObjMap⦈⦇c⦈ ↦⇘𝔄⇙ ?UObj c"
and "ε' c = ?UArr c ∙⇩N⇩T⇩C⇩F ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 f"
using that by metis
qed
have σ_NTMap_app_is_arr'[cat_Kan_cs_intros]: "σ⦇NTMap⦈⦇c⦈ : a ↦⇘𝔄'⇙ b"
if "c ∈⇩∘ ℭ⦇Obj⦈"
and "a = 𝔊⦇ObjMap⦈⦇c⦈"
and "b = ?UObj c"
and "𝔄' = 𝔄"
for 𝔄' a b c
by (simp add: that σ_NTMap_app_is_arr)
have ε'_NTMap_app_def:
"ε' c⦇NTMap⦈⦇A⦈ =
(?UArr c ∙⇩N⇩T⇩C⇩F ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄 (σ⦇NTMap⦈⦇c⦈))⦇NTMap⦈⦇A⦈"
if "A ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈" and "c ∈⇩∘ ℭ⦇Obj⦈" for A c
using ε'_σ_commute[OF that(2)] by simp
have εb_𝔊f:
"ε⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇f⦈ =
?UArr c⦇NTMap⦈⦇a, b, f⦈⇩∙ ∘⇩A⇘𝔄⇙ σ⦇NTMap⦈⦇c⦈"
if "A = [a, b, f]⇩∘" and "A ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈" and "c ∈⇩∘ ℭ⦇Obj⦈"
for A a b c f
proof-
interpret lim_c: is_cat_limit
α ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› ‹?UObj c› ‹?UArr c›
by (rule assms(3)[OF that(3)])
from that have b: "b ∈⇩∘ 𝔅⦇Obj⦈" and f: "f : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
by blast+
show
"ε⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇f⦈ =
?UArr c⦇NTMap⦈⦇a, b, f⦈⇩∙ ∘⇩A⇘𝔄⇙ σ⦇NTMap⦈⦇c⦈"
using ε'_NTMap_app_def[OF that(2,3)] that(2,3)
unfolding that(1)
by
(
cs_prems
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
qed
show "∃!σ.
σ : 𝔊 ↦⇩C⇩F ?the_cf_rKe : ℭ ↦↦⇩C⇘α⇙ 𝔄 ∧
ε = ?the_ntcf_rKe ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
proof(intro ex1I[where a=σ] conjI; (elim conjE)?)
define τ where "τ a b f =
[
(
λF∈⇩∘b ↓⇩C⇩F 𝔎⦇Obj⦈.
?UArr b⦇NTMap⦈⦇F⦈ ∘⇩A⇘𝔄⇙ σ⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇f⦈
),
cf_const (b ↓⇩C⇩F 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇a⦈),
𝔗 ∘⇩C⇩F b ⇩O⨅⇩C⇩F 𝔎,
b ↓⇩C⇩F 𝔎,
𝔄
]⇩∘"
for a b f
have τ_components:
"τ a b f⦇NTMap⦈ =
(
λF∈⇩∘b ↓⇩C⇩F 𝔎⦇Obj⦈.
?UArr b⦇NTMap⦈⦇F⦈ ∘⇩A⇘𝔄⇙ σ⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇f⦈
)"
"τ a b f⦇NTDom⦈ = cf_const (b ↓⇩C⇩F 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇a⦈)"
"τ a b f⦇NTCod⦈ = 𝔗 ∘⇩C⇩F b ⇩O⨅⇩C⇩F 𝔎"
"τ a b f⦇NTDGDom⦈ = b ↓⇩C⇩F 𝔎"
"τ a b f⦇NTDGCod⦈ = 𝔄"
for a b f
unfolding τ_def nt_field_simps by (simp_all add: nat_omega_simps)
note [cat_Kan_cs_simps] = τ_components(2-5)
have τ_NTMap_app[cat_Kan_cs_simps]:
"τ a b f⦇NTMap⦈⦇F⦈ =
?UArr b⦇NTMap⦈⦇F⦈ ∘⇩A⇘𝔄⇙ σ⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇f⦈"
if "F ∈⇩∘ b ↓⇩C⇩F 𝔎⦇Obj⦈" for a b f F
using that unfolding τ_components by auto
have τ: "τ a b f :
𝔊⦇ObjMap⦈⦇a⦈ <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F b ⇩O⨅⇩C⇩F 𝔎 : b ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
if f_is_arr: "f : a ↦⇘ℭ⇙ b" for a b f
proof-
note f = 𝔎.HomCod.cat_is_arrD[OF that]
note lim_a = assms(3)[OF f(2)] and lim_b = assms(3)[OF f(3)]
interpret lim_b: is_cat_limit
α ‹b ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F b ⇩O⨅⇩C⇩F 𝔎› ‹?UObj b› ‹?UArr b›
by (rule lim_b)
from f have a: "a ∈⇩∘ ℭ⦇Obj⦈" and b: "b ∈⇩∘ ℭ⦇Obj⦈" by auto
show ?thesis
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
show "vfsequence (τ a b f)" unfolding τ_def by simp
show "vcard (τ a b f) = 5⇩ℕ"
unfolding τ_def by (simp add: nat_omega_simps)
show "vsv (τ a b f⦇NTMap⦈)" unfolding τ_components by auto
show "𝒟⇩∘ (τ a b f⦇NTMap⦈) = b ↓⇩C⇩F 𝔎⦇Obj⦈" by (auto simp: τ_components)
show "τ a b f⦇NTMap⦈⦇A⦈ :
cf_const (b ↓⇩C⇩F 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇a⦈)⦇ObjMap⦈⦇A⦈ ↦⇘𝔄⇙
(𝔗 ∘⇩C⇩F b ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇A⦈"
if "A ∈⇩∘ b ↓⇩C⇩F 𝔎⦇Obj⦈" for A
proof-
from that f_is_arr obtain b' f'
where A_def: "A = [0, b', f']⇩∘"
and b': "b' ∈⇩∘ 𝔅⦇Obj⦈"
and f': "f' : b ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
by auto
from f_is_arr that b' f' a b show ?thesis
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
)
qed
show
"τ a b f⦇NTMap⦈⦇B⦈ ∘⇩A⇘𝔄⇙
cf_const (b ↓⇩C⇩F 𝔎) 𝔄 (𝔊⦇ObjMap⦈⦇a⦈)⦇ArrMap⦈⦇F⦈ =
(𝔗 ∘⇩C⇩F b ⇩O⨅⇩C⇩F 𝔎)⦇ArrMap⦈⦇F⦈ ∘⇩A⇘𝔄⇙ τ a b f⦇NTMap⦈⦇A⦈"
if "F : A ↦⇘b ↓⇩C⇩F 𝔎⇙ B" for A B F
proof-
from that have F: "F : A ↦⇘b ↓⇩C⇩F 𝔎⇙ B"
by (auto intro: is_arrI)
with f_is_arr obtain b' f' b'' f'' h'
where F_def: "F = [[0, b', f']⇩∘, [0, b'', f'']⇩∘, [0, h']⇩∘]⇩∘"
and A_def: "A = [0, b', f']⇩∘"
and B_def: "B = [0, b'', f'']⇩∘"
and h': "h' : b' ↦⇘𝔅⇙ b''"
and f': "f' : b ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
and f'': "f'' : b ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b''⦈"
and f''_def: "𝔎⦇ArrMap⦈⦇h'⦈ ∘⇩A⇘ℭ⇙ f' = f''"
by auto
from
lim_b.ntcf_Comp_commute[OF that]
that f_is_arr g' h' f' f''
have [cat_Kan_cs_simps]:
"?UArr b⦇NTMap⦈⦇0, b'', 𝔎⦇ArrMap⦈⦇h'⦈ ∘⇩A⇘ℭ⇙ f'⦈⇩∙ =
𝔗⦇ArrMap⦈⦇h'⦈ ∘⇩A⇘𝔄⇙ ?UArr b⦇NTMap⦈⦇0, b', f'⦈⇩∙"
unfolding F_def A_def B_def
by
(
cs_prems
cs_simp:
cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from f_is_arr that g' h' f' f'' show ?thesis
unfolding F_def A_def B_def
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_comma_cs_simps
f''_def[symmetric]
cs_intro:
cat_cs_intros cat_Kan_cs_intros cat_comma_cs_intros
)+
qed
qed
(
use that f_is_arr in
‹
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros
›
)+
qed
show σ: "σ : 𝔊 ↦⇩C⇩F ?the_cf_rKe : ℭ ↦↦⇩C⇘α⇙ 𝔄"
proof(rule is_ntcfI')
show "vfsequence σ" unfolding σ_def by simp
show "vcard σ = 5⇩ℕ" unfolding σ_def by (simp add: nat_omega_simps)
show "vsv (σ⦇NTMap⦈)" unfolding σ_components by auto
show "𝒟⇩∘ (σ⦇NTMap⦈) = ℭ⦇Obj⦈" unfolding σ_components by simp
show "σ⦇NTMap⦈⦇a⦈ : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘𝔄⇙ ?the_cf_rKe⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ ℭ⦇Obj⦈" for a
using that
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
then have [cat_Kan_cs_intros]: "σ⦇NTMap⦈⦇a⦈ : b ↦⇘𝔄⇙ c"
if "a ∈⇩∘ ℭ⦇Obj⦈"
and "b = 𝔊⦇ObjMap⦈⦇a⦈"
and "c = ?the_cf_rKe⦇ObjMap⦈⦇a⦈"
for a b c
using that(1) unfolding that(2,3) by simp
show
"σ⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇f⦈ =
?the_cf_rKe⦇ArrMap⦈⦇f⦈ ∘⇩A⇘𝔄⇙ σ⦇NTMap⦈⦇a⦈"
if f_is_arr: "f : a ↦⇘ℭ⇙ b" for a b f
proof-
note f = 𝔎.HomCod.cat_is_arrD[OF that]
note lim_a = assms(3)[OF f(2)] and lim_b = assms(3)[OF f(3)]
interpret lim_a: is_cat_limit
α ‹a ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F a ⇩O⨅⇩C⇩F 𝔎› ‹?UObj a› ‹?UArr a›
by (rule lim_a)
interpret lim_b: is_cat_limit
α ‹b ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F b ⇩O⨅⇩C⇩F 𝔎› ‹?UObj b› ‹?UArr b›
by (rule lim_b)
from f have a: "a ∈⇩∘ ℭ⦇Obj⦈" and b: "b ∈⇩∘ ℭ⦇Obj⦈" by auto
from lim_b.cat_lim_unique_cone'[OF τ[OF that]] obtain g'
where g': "g' : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘𝔄⇙ ?UObj b"
and τ_NTMap_app: "⋀A. A ∈⇩∘ (b ↓⇩C⇩F 𝔎⦇Obj⦈) ⟹
τ a b f⦇NTMap⦈⦇A⦈ = ?UArr b⦇NTMap⦈⦇A⦈ ∘⇩A⇘𝔄⇙ g'"
and g'_unique: "⋀g''.
⟦
g'' : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘𝔄⇙ ?UObj b;
⋀A. A ∈⇩∘ b ↓⇩C⇩F 𝔎⦇Obj⦈ ⟹
τ a b f⦇NTMap⦈⦇A⦈ = ?UArr b⦇NTMap⦈⦇A⦈ ∘⇩A⇘𝔄⇙ g''
⟧ ⟹ g'' = g'"
by metis
have lim_Obj_a_f𝔎[symmetric, cat_Kan_cs_simps]:
"?UArr a⦇NTMap⦈⦇a', b', f' ∘⇩A⇘ℭ⇙ f⦈⇩∙ =
?UArr b⦇NTMap⦈⦇A⦈ ∘⇩A⇘𝔄⇙ ?the_cf_rKe⦇ArrMap⦈⦇f⦈"
if "A = [a', b', f']⇩∘" and "A ∈⇩∘ b ↓⇩C⇩F 𝔎⦇Obj⦈" for A a' b' f'
proof-
from that(2) f_is_arr have a'_def: "a' = 0"
and b': "b' ∈⇩∘ 𝔅⦇Obj⦈"
and f': "f' : b ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
unfolding that(1) by auto
show ?thesis
unfolding that(1)
by
(
rule
lim_Obj_the_cf_rKe_commute
[
where lim_Obj=lim_Obj,
OF
assms(1,2)
lim_a
lim_b
f_is_arr
that(2)[unfolded that(1)]
]
)
qed
{
fix a' b' f' A
note 𝔗.HomCod.cat_assoc_helper[
where h=‹?UArr b⦇NTMap⦈⦇a',b',f'⦈⇩∙›
and g=‹?the_cf_rKe⦇ArrMap⦈⦇f⦈›
and q=‹?UArr a⦇NTMap⦈⦇a', b', f' ∘⇩A⇘ℭ⇙ f⦈⇩∙›
]
}
note [cat_Kan_cs_simps] = this
show ?thesis
proof(rule trans_sym[where s=g'])
show "σ⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇f⦈ = g'"
proof(rule g'_unique)
from that show
"σ⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇f⦈ : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘𝔄⇙ ?UObj b"
by (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros)
fix A assume prems': "A ∈⇩∘ b ↓⇩C⇩F 𝔎⦇Obj⦈"
with f_is_arr obtain b' f'
where A_def: "A = [0, b', f']⇩∘"
and b': "b' ∈⇩∘ 𝔅⦇Obj⦈"
and f': "f' : b ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
by auto
from f_is_arr prems' show
"τ a b f⦇NTMap⦈⦇A⦈ =
?UArr b⦇NTMap⦈⦇A⦈ ∘⇩A⇘𝔄⇙ (σ⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇f⦈)"
unfolding A_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
qed
show "?the_cf_rKe⦇ArrMap⦈⦇f⦈ ∘⇩A⇘𝔄⇙ σ⦇NTMap⦈⦇a⦈ = g'"
proof(rule g'_unique)
fix A assume prems': "A ∈⇩∘ b ↓⇩C⇩F 𝔎⦇Obj⦈"
with f_is_arr obtain b' f'
where A_def: "A = [0, b', f']⇩∘"
and b': "b' ∈⇩∘ 𝔅⦇Obj⦈"
and f': "f' : b ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
by auto
{
fix a' b' f' A
note 𝔗.HomCod.cat_assoc_helper
[
where h=‹?UArr b⦇NTMap⦈⦇a', b', f'⦈⇩∙›
and g=‹σ⦇NTMap⦈⦇b⦈›
and q=‹ε⦇NTMap⦈⦇b'⦈ ∘⇩A⇘𝔄⇙ 𝔊⦇ArrMap⦈⦇f'⦈›
]
}
note [cat_Kan_cs_simps] =
this
εb_𝔊f[OF A_def prems' b, symmetric]
εb_𝔊f[symmetric]
from f_is_arr prems' b' f' show
"τ a b f⦇NTMap⦈⦇A⦈ =
?UArr b⦇NTMap⦈⦇A⦈ ∘⇩A⇘𝔄⇙
(?the_cf_rKe⦇ArrMap⦈⦇f⦈ ∘⇩A⇘𝔄⇙ σ⦇NTMap⦈⦇a⦈)"
unfolding A_def
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_comma_cs_simps
cat_op_simps
cs_intro:
cat_cs_intros
cat_Kan_cs_intros
cat_comma_cs_intros
cat_op_intros
)
qed
(
use that in
‹
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
›
)
qed
qed
qed
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros
)+
then interpret σ: is_ntcf α ℭ 𝔄 𝔊 ‹?the_cf_rKe› σ by simp
show "ε = ?the_ntcf_rKe ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
proof(rule ntcf_eqI)
have dom_lhs: "𝒟⇩∘ (ε⦇NTMap⦈) = 𝔅⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
have dom_rhs: "𝒟⇩∘ ((?the_ntcf_rKe ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎))⦇NTMap⦈) = 𝔅⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "ε⦇NTMap⦈ = (?the_ntcf_rKe ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎))⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix b assume prems': "b ∈⇩∘ 𝔅⦇Obj⦈"
note [cat_Kan_cs_simps] = εb_𝔊f[
where f=‹ℭ⦇CId⦈⦇𝔎⦇ObjMap⦈⦇b⦈⦈› and c=‹𝔎⦇ObjMap⦈⦇b⦈›, symmetric
]
from prems' σ show
"ε⦇NTMap⦈⦇b⦈ = (?the_ntcf_rKe ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎))⦇NTMap⦈⦇b⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros V_cs_intros)
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
fix σ' assume prems':
"σ' : 𝔊 ↦⇩C⇩F ?the_cf_rKe : ℭ ↦↦⇩C⇘α⇙ 𝔄"
"ε = ?the_ntcf_rKe ∙⇩N⇩T⇩C⇩F (σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
interpret σ': is_ntcf α ℭ 𝔄 𝔊 ‹?the_cf_rKe› σ' by (rule prems'(1))
have ε_NTMap_app[symmetric, cat_Kan_cs_simps]:
"ε⦇NTMap⦈⦇b'⦈ =
?UArr (𝔎⦇ObjMap⦈⦇b'⦈)⦇NTMap⦈⦇a', b', ℭ⦇CId⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈⦈⇩∙ ∘⇩A⇘𝔄⇙
σ'⦇NTMap⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈"
if "b' ∈⇩∘ 𝔅⦇Obj⦈" and "a' = 0" for a' b'
proof-
from prems'(2) have ε_NTMap_app:
"ε⦇NTMap⦈⦇b'⦈ = (?the_ntcf_rKe ∙⇩N⇩T⇩C⇩F (σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎))⦇NTMap⦈⦇b'⦈"
for b'
by simp
show ?thesis
using ε_NTMap_app[of b'] that(1)
unfolding that(2)
by
(
cs_prems
cs_simp: cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
{
fix a' b' f' A
note 𝔗.HomCod.cat_assoc_helper
[
where h=
‹?UArr (𝔎⦇ObjMap⦈⦇b'⦈)⦇NTMap⦈⦇a', b', ℭ⦇CId⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈⦈⇩∙›
and g=‹σ'⦇NTMap⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈›
and q=‹ε⦇NTMap⦈⦇b'⦈›
]
}
note [cat_Kan_cs_simps] = this εb_𝔊f[symmetric]
{
fix a' b' f' A
note 𝔗.HomCod.cat_assoc_helper
[
where h=‹
?UArr (𝔎⦇ObjMap⦈⦇b'⦈)⦇NTMap⦈⦇
a', b', ℭ⦇CId⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈
⦈⇩∙›
and g=‹σ⦇NTMap⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈›
and q=‹ε⦇NTMap⦈⦇b'⦈›
]
}
note [cat_Kan_cs_simps] = this
show "σ' = σ"
proof(rule ntcf_eqI)
show "σ' : 𝔊 ↦⇩C⇩F ?the_cf_rKe : ℭ ↦↦⇩C⇘α⇙ 𝔄" by (rule prems'(1))
show "σ : 𝔊 ↦⇩C⇩F ?the_cf_rKe : ℭ ↦↦⇩C⇘α⇙ 𝔄" by (rule σ)
have dom_lhs: "𝒟⇩∘ (σ⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
have dom_rhs: "𝒟⇩∘ (σ'⦇NTMap⦈) = ℭ⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
show "σ'⦇NTMap⦈ = σ⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix c assume prems': "c ∈⇩∘ ℭ⦇Obj⦈"
note lim_c = assms(3)[OF prems']
interpret lim_c: is_cat_limit
α ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› ‹?UObj c› ‹?UArr c›
by (rule lim_c)
from prems' have CId_c: "ℭ⦇CId⦈⦇c⦈ : c ↦⇘ℭ⇙ c"
by (cs_concl cs_intro: cat_cs_intros)
from lim_c.cat_lim_unique_cone'[OF τ[OF CId_c]] obtain f
where f: "f : 𝔊⦇ObjMap⦈⦇c⦈ ↦⇘𝔄⇙ ?UObj c"
and "⋀A. A ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈ ⟹
τ c c (ℭ⦇CId⦈⦇c⦈)⦇NTMap⦈⦇A⦈ = ?UArr c⦇NTMap⦈⦇A⦈ ∘⇩A⇘𝔄⇙ f"
and f_unique: "⋀f'.
⟦
f' : 𝔊⦇ObjMap⦈⦇c⦈ ↦⇘𝔄⇙ ?UObj c;
⋀A. A ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈ ⟹
τ c c (ℭ⦇CId⦈⦇c⦈)⦇NTMap⦈⦇A⦈ = ?UArr c⦇NTMap⦈⦇A⦈ ∘⇩A⇘𝔄⇙ f'
⟧ ⟹ f' = f"
by metis
note [symmetric, cat_cs_simps] =
σ.ntcf_Comp_commute
σ'.ntcf_Comp_commute
show "σ'⦇NTMap⦈⦇c⦈ = σ⦇NTMap⦈⦇c⦈"
proof(rule trans_sym[where s=f])
show "σ'⦇NTMap⦈⦇c⦈ = f"
proof(rule f_unique)
fix A assume prems'': "A ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈"
with prems' obtain b' f'
where A_def: "A = [0, b', f']⇩∘"
and b': "b' ∈⇩∘ 𝔅⦇Obj⦈"
and f': "f' : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
by auto
let ?𝔎b' = ‹𝔎⦇ObjMap⦈⦇b'⦈›
from b' have 𝔎b': "?𝔎b' ∈⇩∘ ℭ⦇Obj⦈"
by (cs_concl cs_intro: cat_cs_intros)
interpret lim_𝔎b': is_cat_limit
α ‹?𝔎b' ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F ?𝔎b' ⇩O⨅⇩C⇩F 𝔎› ‹?UObj ?𝔎b'› ‹?UArr ?𝔎b'›
by (rule assms(3)[OF 𝔎b'])
from 𝔎b' have CId_𝔎b': "ℭ⦇CId⦈⦇?𝔎b'⦈ : ?𝔎b' ↦⇘ℭ⇙ ?𝔎b'"
by (cs_concl cs_intro: cat_cs_intros)
from CId_𝔎b' b' have a'_b'_CId_𝔎b':
"[0, b', ℭ⦇CId⦈⦇?𝔎b'⦈]⇩∘ ∈⇩∘ ?𝔎b' ↓⇩C⇩F 𝔎⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from
lim_Obj_the_cf_rKe_commute[
where lim_Obj=lim_Obj,
OF assms(1,2) lim_c assms(3)[OF 𝔎b'] f' a'_b'_CId_𝔎b'
]
f'
have [cat_Kan_cs_simps]:
"?UArr c⦇NTMap⦈⦇0, b', f'⦈⇩∙ =
?UArr ?𝔎b'⦇NTMap⦈⦇0, b', ℭ⦇CId⦈⦇?𝔎b'⦈⦈⇩∙ ∘⇩A⇘𝔄⇙
?the_cf_rKe⦇ArrMap⦈⦇f'⦈"
by (cs_prems cs_simp: cat_cs_simps)
from prems' prems'' b' f' show
"τ c c (ℭ⦇CId⦈⦇c⦈)⦇NTMap⦈⦇A⦈ = ?UArr c⦇NTMap⦈⦇A⦈ ∘⇩A⇘𝔄⇙ σ'⦇NTMap⦈⦇c⦈"
unfolding A_def
by
(
cs_concl
cs_simp:
cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro:
cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
)
qed
(
use prems' in
‹cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros›
)
show "σ⦇NTMap⦈⦇c⦈ = f"
proof(rule f_unique)
fix A assume prems'': "A ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈"
from this prems' obtain b' f'
where A_def: "A = [0, b', f']⇩∘"
and b': "b' ∈⇩∘ 𝔅⦇Obj⦈"
and f': "f' : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
by auto
let ?𝔎b' = ‹𝔎⦇ObjMap⦈⦇b'⦈›
from b' have 𝔎b': "?𝔎b' ∈⇩∘ ℭ⦇Obj⦈"
by (cs_concl cs_intro: cat_cs_intros)
interpret lim_𝔎b': is_cat_limit
α ‹?𝔎b' ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F ?𝔎b' ⇩O⨅⇩C⇩F 𝔎› ‹?UObj ?𝔎b'› ‹?UArr ?𝔎b'›
by (rule assms(3)[OF 𝔎b'])
from 𝔎b' have CId_𝔎b': "ℭ⦇CId⦈⦇?𝔎b'⦈ : ?𝔎b' ↦⇘ℭ⇙ ?𝔎b'"
by (cs_concl cs_intro: cat_cs_intros)
from CId_𝔎b' b' have a'_b'_CId_𝔎b':
"[0, b', ℭ⦇CId⦈⦇?𝔎b'⦈]⇩∘ ∈⇩∘ ?𝔎b' ↓⇩C⇩F 𝔎⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_comma_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
from
lim_Obj_the_cf_rKe_commute
[
where lim_Obj=lim_Obj,
OF assms(1,2) lim_c assms(3)[OF 𝔎b'] f' a'_b'_CId_𝔎b'
]
f'
have [cat_Kan_cs_simps]:
"?UArr c⦇NTMap⦈⦇0, b', f'⦈⇩∙ =
?UArr (?𝔎b')⦇NTMap⦈⦇0, b', ℭ⦇CId⦈⦇?𝔎b'⦈⦈⇩∙ ∘⇩A⇘𝔄⇙
?the_cf_rKe⦇ArrMap⦈⦇f'⦈"
by (cs_prems cs_simp: cat_cs_simps)
from prems' prems'' b' f' show
"τ c c (ℭ⦇CId⦈⦇c⦈)⦇NTMap⦈⦇A⦈ = ?UArr c⦇NTMap⦈⦇A⦈ ∘⇩A⇘𝔄⇙ σ⦇NTMap⦈⦇c⦈"
unfolding A_def
by
(
cs_concl
cs_simp:
cat_cs_simps cat_comma_cs_simps cat_Kan_cs_simps
cs_intro:
cat_cs_intros cat_comma_cs_intros cat_Kan_cs_intros
)
qed
(
use prems' in
‹cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros›
)
qed
qed auto
qed simp_all
qed
qed (cs_concl cs_intro: cat_cs_intros)+
qed
subsection‹Preservation of Kan extension›
text‹
The following definitions are similar to the definitions that can be
found in \cite{riehl_category_2016} or \cite{lehner_all_2014}.
›
locale is_cat_rKe_preserves =
is_cat_rKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔊 ε + is_functor α 𝔄 𝔇 ℌ
for α 𝔅 ℭ 𝔄 𝔇 𝔎 𝔗 𝔊 ℌ ε +
assumes cat_rKe_preserves:
"ℌ ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ε : (ℌ ∘⇩C⇩F 𝔊) ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ ℌ ∘⇩C⇩F 𝔗 : 𝔅 ↦⇩C ℭ ↦⇩C 𝔇"
syntax "_is_cat_rKe_preserves" ::
"V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(
‹(_ :/ _ ∘⇩C⇩F _ ↦⇩C⇩F⇩.⇩r⇩K⇩eı _ :/ _ ↦⇩C _ ↦⇩C _ : _ ↦↦⇩C _)›
[51, 51, 51, 51, 51, 51, 51, 51, 51] 51
)
translations "ε : 𝔊 ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 : 𝔅 ↦⇩C ℭ ↦⇩C (ℌ : 𝔄 ↦↦⇩C 𝔇)" ⇌
"CONST is_cat_rKe_preserves α 𝔅 ℭ 𝔄 𝔇 𝔎 𝔗 𝔊 ℌ ε"
locale is_cat_lKe_preserves =
is_cat_lKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔉 η + is_functor α 𝔄 𝔇 ℌ
for α 𝔅 ℭ 𝔄 𝔇 𝔎 𝔗 𝔉 ℌ η +
assumes cat_lKe_preserves:
"ℌ ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F η : ℌ ∘⇩C⇩F 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ (ℌ ∘⇩C⇩F 𝔉) ∘⇩C⇩F 𝔎 : 𝔅 ↦⇩C ℭ ↦⇩C 𝔇"
syntax "_is_cat_lKe_preserves" ::
"V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(
‹(_ :/ _ ↦⇩C⇩F⇩.⇩l⇩K⇩eı _ ∘⇩C⇩F _ :/ _ ↦⇩C _ ↦⇩C _ : _ ↦↦⇩C _)›
[51, 51, 51, 51, 51, 51, 51, 51, 51] 51
)
translations "η : 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ 𝔉 ∘⇩C⇩F 𝔎 : 𝔅 ↦⇩C ℭ ↦⇩C (ℌ : 𝔄 ↦↦⇩C 𝔇)" ⇌
"CONST is_cat_lKe_preserves α 𝔅 ℭ 𝔄 𝔇 𝔎 𝔗 𝔉 ℌ η"
text‹Rules.›
lemma (in is_cat_rKe_preserves) is_cat_rKe_preserves_axioms':
assumes "α' = α"
and "𝔊' = 𝔊"
and "𝔎' = 𝔎"
and "𝔗' = 𝔗"
and "ℌ' = ℌ"
and "𝔅' = 𝔅"
and "𝔄' = 𝔄"
and "ℭ' = ℭ"
and "𝔇' = 𝔇"
shows "ε : 𝔊' ∘⇩C⇩F 𝔎' ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α'⇙ 𝔗' : 𝔅' ↦⇩C ℭ' ↦⇩C (ℌ' : 𝔄' ↦↦⇩C 𝔇')"
unfolding assms by (rule is_cat_rKe_preserves_axioms)
mk_ide rf is_cat_rKe_preserves_def[unfolded is_cat_rKe_preserves_axioms_def]
|intro is_cat_rKe_preservesI|
|dest is_cat_rKe_preservesD[dest]|
|elim is_cat_rKe_preservesE[elim]|
lemmas [cat_Kan_cs_intros] = is_cat_rKeD(1-3)
lemma (in is_cat_lKe_preserves) is_cat_lKe_preserves_axioms':
assumes "α' = α"
and "𝔉' = 𝔉"
and "𝔎' = 𝔎"
and "𝔗' = 𝔗"
and "ℌ' = ℌ"
and "𝔅' = 𝔅"
and "𝔄' = 𝔄"
and "ℭ' = ℭ"
and "𝔇' = 𝔇"
shows "η : 𝔗' ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ 𝔉' ∘⇩C⇩F 𝔎' : 𝔅' ↦⇩C ℭ' ↦⇩C (ℌ' : 𝔄' ↦↦⇩C 𝔇')"
unfolding assms by (rule is_cat_lKe_preserves_axioms)
mk_ide rf is_cat_lKe_preserves_def[unfolded is_cat_lKe_preserves_axioms_def]
|intro is_cat_lKe_preservesI|
|dest is_cat_lKe_preservesD[dest]|
|elim is_cat_lKe_preservesE[elim]|
lemmas [cat_Kan_cs_intros] = is_cat_lKe_preservesD(1-3)
text‹Duality.›
lemma (in is_cat_rKe_preserves) is_cat_rKe_preserves_op:
"op_ntcf ε :
op_cf 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ op_cf 𝔊 ∘⇩C⇩F op_cf 𝔎 :
op_cat 𝔅 ↦⇩C op_cat ℭ ↦⇩C (op_cf ℌ : op_cat 𝔄 ↦↦⇩C op_cat 𝔇)"
proof(intro is_cat_lKe_preservesI)
from cat_rKe_preserves show "op_cf ℌ ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F op_ntcf ε :
op_cf ℌ ∘⇩C⇩F op_cf 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ (op_cf ℌ ∘⇩C⇩F op_cf 𝔊) ∘⇩C⇩F op_cf 𝔎 :
op_cat 𝔅 ↦⇩C op_cat ℭ ↦⇩C op_cat 𝔇"
by (cs_concl_step op_ntcf_cf_ntcf_comp[symmetric])
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
qed (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
lemma (in is_cat_rKe_preserves) is_cat_lKe_preserves_op'[cat_op_intros]:
assumes "𝔗' = op_cf 𝔗"
and "𝔊' = op_cf 𝔊"
and "𝔎' = op_cf 𝔎"
and "𝔅' = op_cat 𝔅"
and "𝔄' = op_cat 𝔄"
and "ℭ' = op_cat ℭ"
and "𝔇' = op_cat 𝔇"
and "ℌ' = op_cf ℌ"
shows "op_ntcf ε :
𝔗' ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ 𝔊' ∘⇩C⇩F 𝔎' : 𝔅' ↦⇩C ℭ' ↦⇩C (ℌ' : 𝔄' ↦↦⇩C 𝔇')"
unfolding assms by (rule is_cat_rKe_preserves_op)
lemmas [cat_op_intros] = is_cat_rKe_preserves.is_cat_lKe_preserves_op'
lemma (in is_cat_lKe_preserves) is_cat_rKe_preserves_op:
"op_ntcf η :
op_cf 𝔉 ∘⇩C⇩F op_cf 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ op_cf 𝔗 :
op_cat 𝔅 ↦⇩C op_cat ℭ ↦⇩C (op_cf ℌ : op_cat 𝔄 ↦↦⇩C op_cat 𝔇)"
proof(intro is_cat_rKe_preservesI)
from cat_lKe_preserves show "op_cf ℌ ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F op_ntcf η :
(op_cf ℌ ∘⇩C⇩F op_cf 𝔉) ∘⇩C⇩F op_cf 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ op_cf ℌ ∘⇩C⇩F op_cf 𝔗 :
op_cat 𝔅 ↦⇩C op_cat ℭ ↦⇩C op_cat 𝔇"
by (cs_concl_step op_ntcf_cf_ntcf_comp[symmetric])
(cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)
qed (cs_concl cs_simp: cat_op_simps cs_intro: cat_op_intros)+
lemma (in is_cat_lKe_preserves) is_cat_rKe_preserves_op'[cat_op_intros]:
assumes "𝔗' = op_cf 𝔗"
and "𝔉' = op_cf 𝔉"
and "𝔎' = op_cf 𝔎"
and "ℌ' = op_cf ℌ"
and "𝔅' = op_cat 𝔅"
and "𝔄' = op_cat 𝔄"
and "ℭ' = op_cat ℭ"
and "𝔇' = op_cat 𝔇"
shows "op_ntcf η :
𝔉' ∘⇩C⇩F 𝔎' ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗' : 𝔅' ↦⇩C ℭ' ↦⇩C (ℌ' : 𝔄' ↦↦⇩C 𝔇')"
unfolding assms by (rule is_cat_rKe_preserves_op)
subsection‹All concepts are Kan extensions›
text‹
Background information for this subsection is provided in
Chapter X-7 in \cite{mac_lane_categories_2010}
and section 6.5 in \cite{riehl_category_2016}.
It should be noted that only the connections between the Kan extensions,
limits and adjunctions are exposed (an alternative proof of the Yoneda
lemma using Kan extensions is not provided in the context of this work).
›
subsubsection‹Limits›
lemma cat_rKe_is_cat_limit:
assumes "ε : 𝔊 ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 : 𝔅 ↦⇩C cat_1 𝔞 𝔣 ↦⇩C 𝔄"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
shows "ε : 𝔊⦇ObjMap⦈⦇𝔞⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
proof-
interpret ε: is_cat_rKe α 𝔅 ‹cat_1 𝔞 𝔣› 𝔄 𝔎 𝔗 𝔊 ε by (rule assms(1))
interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
from cat_1_components(1) have 𝔞: "𝔞 ∈⇩∘ Vset α"
by (auto simp: ε.AG.HomCod.cat_in_Obj_in_Vset)
from cat_1_components(2) have 𝔣: "𝔣 ∈⇩∘ Vset α"
by (auto simp: ε.AG.HomCod.cat_in_Arr_in_Vset)
have 𝔎_def: "𝔎 = cf_const 𝔅 (cat_1 𝔞 𝔣) 𝔞"
by (rule cf_const_if_HomCod_is_cat_1)
(cs_concl cs_intro: cat_cs_intros)
have 𝔊𝔎_def: "𝔊 ∘⇩C⇩F 𝔎 = cf_const 𝔅 𝔄 (𝔊⦇ObjMap⦈⦇𝔞⦈)"
by
(
cs_concl
cs_simp: cat_1_components(1) 𝔎_def cat_cs_simps
cs_intro: V_cs_intros cat_cs_intros
)
interpret ε: is_tm_ntcf α 𝔅 𝔄 ‹𝔊 ∘⇩C⇩F 𝔎› 𝔗 ε
by
(
intro is_tm_ntcfI' assms(2) ε.ntcf_rKe.is_ntcf_axioms,
unfold 𝔊𝔎_def
)
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_small_cs_intros cat_cs_intros
)
show "ε : 𝔊⦇ObjMap⦈⦇𝔞⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
proof(intro is_cat_limitI' is_cat_coneI)
show "ε : cf_const 𝔅 𝔄 (𝔊⦇ObjMap⦈⦇𝔞⦈) ↦⇩C⇩F⇩.⇩t⇩m 𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
proof(intro is_tm_ntcfI' ε.ntcf_rKe.is_ntcf_axioms[unfolded 𝔊𝔎_def])
from assms(2) show "cf_const 𝔅 𝔄 (𝔊⦇ObjMap⦈⦇𝔞⦈) : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
qed (rule assms(2))
fix u' r' assume prems: "u' : r' <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
interpret u': is_cat_cone α r' 𝔅 𝔄 𝔗 u' by (rule prems)
have 𝔊_def: "𝔊 = cf_const (cat_1 𝔞 𝔣) 𝔄 (𝔊⦇ObjMap⦈⦇𝔞⦈)"
by (rule cf_const_if_HomDom_is_cat_1[OF ε.Ran.is_functor_axioms])
from prems have const_r': "cf_const (cat_1 𝔞 𝔣) 𝔄 r' : cat_1 𝔞 𝔣 ↦↦⇩C⇘α⇙ 𝔄"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_lim_cs_intros cat_cs_intros
)
have cf_comp_cf_const_r_𝔎_def:
"cf_const (cat_1 𝔞 𝔣) 𝔄 r' ∘⇩C⇩F 𝔎 = cf_const 𝔅 𝔄 r'"
by
(
cs_concl
cs_simp: cat_cs_simps 𝔎_def
cs_intro: cat_cs_intros cat_lim_cs_intros
)
from ε.cat_rKe_unique[
OF const_r', unfolded cf_comp_cf_const_r_𝔎_def, OF u'.is_ntcf_axioms
]
obtain σ
where σ: "σ : cf_const (cat_1 𝔞 𝔣) 𝔄 r' ↦⇩C⇩F 𝔊 : cat_1 𝔞 𝔣 ↦↦⇩C⇘α⇙ 𝔄"
and u'_def: "u' = ε ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
and unique_σ: "⋀σ'.
⟦
σ' : cf_const (cat_1 𝔞 𝔣) 𝔄 r' ↦⇩C⇩F 𝔊 : cat_1 𝔞 𝔣 ↦↦⇩C⇘α⇙ 𝔄;
u' = ε ∙⇩N⇩T⇩C⇩F (σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)
⟧ ⟹ σ' = σ"
by auto
interpret σ: is_ntcf α ‹cat_1 𝔞 𝔣› 𝔄 ‹cf_const (cat_1 𝔞 𝔣) 𝔄 r'› 𝔊 σ
by (rule σ)
show "∃!f'. f' : r' ↦⇘𝔄⇙ 𝔊⦇ObjMap⦈⦇𝔞⦈ ∧ u' = ε ∙⇩N⇩T⇩C⇩F ntcf_const 𝔅 𝔄 f'"
proof(intro ex1I conjI; (elim conjE)?)
fix f' assume prems':
"f' : r' ↦⇘𝔄⇙ 𝔊⦇ObjMap⦈⦇𝔞⦈" "u' = ε ∙⇩N⇩T⇩C⇩F ntcf_const 𝔅 𝔄 f'"
from prems'(1) have "ntcf_const (cat_1 𝔞 𝔣) 𝔄 f' :
cf_const (cat_1 𝔞 𝔣) 𝔄 r' ↦⇩C⇩F 𝔊 : cat_1 𝔞 𝔣 ↦↦⇩C⇘α⇙ 𝔄"
by (subst 𝔊_def)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
moreover then have "u' = ε ∙⇩N⇩T⇩C⇩F (ntcf_const (cat_1 𝔞 𝔣) 𝔄 f' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
by
(
cs_concl
cs_simp: cat_cs_simps prems'(2) 𝔎_def cs_intro: cat_cs_intros
)
ultimately have σ_def: "σ = ntcf_const (cat_1 𝔞 𝔣) 𝔄 f'"
by (auto simp: unique_σ[symmetric])
show "f' = σ⦇NTMap⦈⦇𝔞⦈"
by (cs_concl cs_simp: cat_cs_simps σ_def cs_intro: cat_cs_intros)
qed (cs_concl cs_simp: cat_cs_simps u'_def 𝔎_def cs_intro: cat_cs_intros)+
qed (cs_concl cs_simp: 𝔎_def cs_intro: cat_cs_intros)
qed
lemma cat_lKe_is_cat_colimit:
assumes "η : 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ 𝔉 ∘⇩C⇩F 𝔎 : 𝔅 ↦⇩C cat_1 𝔞 𝔣 ↦⇩C 𝔄"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
shows "η : 𝔗 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m 𝔉⦇ObjMap⦈⦇𝔞⦈ : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
proof-
interpret η: is_cat_lKe α 𝔅 ‹cat_1 𝔞 𝔣› 𝔄 𝔎 𝔗 𝔉 η by (rule assms(1))
interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
from cat_1_components(1) have 𝔞: "𝔞 ∈⇩∘ Vset α"
by (auto simp: η.AG.HomCod.cat_in_Obj_in_Vset)
from cat_1_components(2) have 𝔣: "𝔣 ∈⇩∘ Vset α"
by (auto simp: η.AG.HomCod.cat_in_Arr_in_Vset)
show ?thesis
by
(
rule is_cat_limit.is_cat_colimit_op
[
OF cat_rKe_is_cat_limit[
OF η.is_cat_rKe_op[unfolded η.AG.cat_1_op[OF 𝔞 𝔣]]
𝔗.is_tm_functor_op
],
unfolded cat_op_simps
]
)
qed
lemma cat_limit_is_rKe:
assumes "ε : 𝔊⦇ObjMap⦈⦇𝔞⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ cat_1 𝔞 𝔣"
and "𝔊 : cat_1 𝔞 𝔣 ↦↦⇩C⇘α⇙ 𝔄"
shows "ε : 𝔊 ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 : 𝔅 ↦⇩C cat_1 𝔞 𝔣 ↦⇩C 𝔄"
proof-
interpret ε: is_cat_limit α 𝔅 𝔄 𝔗 ‹𝔊⦇ObjMap⦈⦇𝔞⦈› ε by (rule assms)
interpret 𝔎: is_functor α 𝔅 ‹cat_1 𝔞 𝔣› 𝔎 by (rule assms(2))
interpret 𝔊: is_functor α ‹cat_1 𝔞 𝔣› 𝔄 𝔊 by (rule assms(3))
show ?thesis
proof(rule is_cat_rKeI')
note 𝔎_def = cf_const_if_HomCod_is_cat_1[OF assms(2)]
note 𝔊_def = cf_const_if_HomDom_is_cat_1[OF assms(3)]
have 𝔊𝔎_def: "𝔊 ∘⇩C⇩F 𝔎 = cf_const 𝔅 𝔄 (𝔊⦇ObjMap⦈⦇𝔞⦈)"
by (subst 𝔎_def, use nothing in ‹subst 𝔊_def›)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "ε : 𝔊 ∘⇩C⇩F 𝔎 ↦⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
by (cs_concl cs_simp: cat_cs_simps 𝔊𝔎_def cs_intro: cat_cs_intros)
fix 𝔊' ε' assume prems:
"𝔊' : cat_1 𝔞 𝔣 ↦↦⇩C⇘α⇙ 𝔄"
"ε' : 𝔊' ∘⇩C⇩F 𝔎 ↦⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
interpret is_functor α ‹cat_1 𝔞 𝔣› 𝔄 𝔊' by (rule prems(1))
note 𝔊'_def = cf_const_if_HomDom_is_cat_1[OF prems(1)]
from prems(2) have ε':
"ε' : cf_const 𝔅 𝔄 (𝔊'⦇ObjMap⦈⦇𝔞⦈) ↦⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
unfolding 𝔎_def
by (subst (asm) 𝔊'_def)
(cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from prems(2) have "ε' : 𝔊'⦇ObjMap⦈⦇𝔞⦈ <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
by (intro is_cat_coneI is_tm_ntcfI' ε')
(cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)+
from ε.cat_lim_unique_cone[OF this] obtain f'
where f': "f' : 𝔊'⦇ObjMap⦈⦇𝔞⦈ ↦⇘𝔄⇙ 𝔊⦇ObjMap⦈⦇𝔞⦈"
and ε_def: "ε' = ε ∙⇩N⇩T⇩C⇩F ntcf_const 𝔅 𝔄 f'"
and unique_f':
"⟦
f'' : 𝔊'⦇ObjMap⦈⦇𝔞⦈ ↦⇘𝔄⇙ 𝔊⦇ObjMap⦈⦇𝔞⦈;
ε' = ε ∙⇩N⇩T⇩C⇩F ntcf_const 𝔅 𝔄 f''
⟧ ⟹ f'' = f'"
for f''
by metis
show "∃!σ.
σ : 𝔊' ↦⇩C⇩F 𝔊 : cat_1 𝔞 𝔣 ↦↦⇩C⇘α⇙ 𝔄 ∧ ε' = ε ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
proof(intro ex1I conjI; (elim conjE)?)
from f' show
"ntcf_const (cat_1 𝔞 𝔣) 𝔄 f' : 𝔊' ↦⇩C⇩F 𝔊 : cat_1 𝔞 𝔣 ↦↦⇩C⇘α⇙ 𝔄"
by (subst 𝔊'_def, use nothing in ‹subst 𝔊_def›)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
then show "ε' = ε ∙⇩N⇩T⇩C⇩F (ntcf_const (cat_1 𝔞 𝔣) 𝔄 f' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
by (cs_concl cs_simp: cat_cs_simps ε_def 𝔎_def cs_intro: cat_cs_intros)
fix σ assume prems:
"σ : 𝔊' ↦⇩C⇩F 𝔊 : cat_1 𝔞 𝔣 ↦↦⇩C⇘α⇙ 𝔄"
"ε' = ε ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)"
interpret σ: is_ntcf α ‹cat_1 𝔞 𝔣› 𝔄 𝔊' 𝔊 σ by (rule prems(1))
have "σ⦇NTMap⦈⦇𝔞⦈ : 𝔊'⦇ObjMap⦈⦇𝔞⦈ ↦⇘𝔄⇙ 𝔊⦇ObjMap⦈⦇𝔞⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
moreover have "ε' = ε ∙⇩N⇩T⇩C⇩F ntcf_const 𝔅 𝔄 (σ⦇NTMap⦈⦇𝔞⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps prems(2) 𝔎_def cs_intro: cat_cs_intros
)
ultimately have σ𝔞: "σ⦇NTMap⦈⦇𝔞⦈ = f'" by (rule unique_f')
show "σ = ntcf_const (cat_1 𝔞 𝔣) 𝔄 f'"
proof(rule ntcf_eqI)
from f' show
"ntcf_const (cat_1 𝔞 𝔣) 𝔄 f' : 𝔊' ↦⇩C⇩F 𝔊 : cat_1 𝔞 𝔣 ↦↦⇩C⇘α⇙ 𝔄"
by (subst 𝔊'_def, use nothing in ‹subst 𝔊_def›)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have dom_lhs: "𝒟⇩∘ (σ⦇NTMap⦈) = cat_1 𝔞 𝔣⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro:cat_cs_intros)
have dom_rhs: "𝒟⇩∘ (ntcf_const (cat_1 𝔞 𝔣) 𝔄 f'⦇NTMap⦈) = cat_1 𝔞 𝔣⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro:cat_cs_intros)
show "σ⦇NTMap⦈ = ntcf_const (cat_1 𝔞 𝔣) 𝔄 f'⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ∈⇩∘ cat_1 𝔞 𝔣⦇Obj⦈"
then have a_def: "a = 𝔞" unfolding cat_1_components by simp
from f' show "σ⦇NTMap⦈⦇a⦈ = ntcf_const (cat_1 𝔞 𝔣) 𝔄 f'⦇NTMap⦈⦇a⦈"
unfolding a_def σ𝔞
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: cat_cs_intros)
qed (simp_all add: prems)
qed
qed (auto simp: assms)
qed
lemma cat_colimit_is_lKe:
assumes "η : 𝔗 >⇩C⇩F⇩.⇩c⇩o⇩l⇩i⇩m 𝔉⦇ObjMap⦈⦇𝔞⦈ : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ cat_1 𝔞 𝔣"
and "𝔉 : cat_1 𝔞 𝔣 ↦↦⇩C⇘α⇙ 𝔄"
shows "η : 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ 𝔉 ∘⇩C⇩F 𝔎 : 𝔅 ↦⇩C cat_1 𝔞 𝔣 ↦⇩C 𝔄"
proof-
interpret η: is_cat_colimit α 𝔅 𝔄 𝔗 ‹𝔉⦇ObjMap⦈⦇𝔞⦈› η
by (rule assms(1))
interpret 𝔎: is_functor α 𝔅 ‹cat_1 𝔞 𝔣› 𝔎 by (rule assms(2))
interpret 𝔉: is_functor α ‹cat_1 𝔞 𝔣› 𝔄 𝔉 by (rule assms(3))
from cat_1_components(1) have 𝔞: "𝔞 ∈⇩∘ Vset α"
by (auto simp: 𝔎.HomCod.cat_in_Obj_in_Vset)
from cat_1_components(2) have 𝔣: "𝔣 ∈⇩∘ Vset α"
by (auto simp: 𝔎.HomCod.cat_in_Arr_in_Vset)
have 𝔉𝔞: "𝔉⦇ObjMap⦈⦇𝔞⦈ = op_cf 𝔉⦇ObjMap⦈⦇𝔞⦈" unfolding cat_op_simps by simp
note cat_1_op = η.cat_1_op[OF 𝔞 𝔣]
show ?thesis
by
(
rule is_cat_rKe.is_cat_lKe_op
[
OF cat_limit_is_rKe
[
OF
η.is_cat_limit_op[unfolded 𝔉𝔞]
𝔎.is_functor_op[unfolded cat_1_op]
𝔉.is_functor_op[unfolded cat_1_op]
],
unfolded cat_op_simps cat_1_op
]
)
qed
subsubsection‹Adjoints›
lemma (in is_cf_adjunction) cf_adjunction_counit_is_rKe:
shows "ε⇩C Φ : 𝔉 ∘⇩C⇩F 𝔊 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ cf_id 𝔇 : 𝔇 ↦⇩C ℭ ↦⇩C 𝔇"
proof-
define β where "β = α + ω"
have β: "𝒵 β" and αβ: "α ∈⇩∘ β"
by (simp_all add: β_def 𝒵_Limit_αω 𝒵_ω_αω 𝒵_def 𝒵_α_αω)
then interpret β: 𝒵 β by simp
note exp_adj = cf_adj_exp_cf_cat_exp_cf_cat[OF β αβ R.category_axioms]
let ?η = ‹η⇩C Φ›
let ?ε = ‹ε⇩C Φ›
let ?𝔇η = ‹exp_cat_ntcf α 𝔇 ?η›
let ?𝔇𝔉 = ‹exp_cat_cf α 𝔇 𝔉›
let ?𝔇𝔊 = ‹exp_cat_cf α 𝔇 𝔊›
let ?𝔇𝔇 = ‹cat_FUNCT α 𝔇 𝔇›
let ?ℭ𝔇 = ‹cat_FUNCT α ℭ 𝔇›
let ?adj_𝔇η = ‹cf_adjunction_of_unit β ?𝔇𝔊 ?𝔇𝔉 ?𝔇η›
interpret 𝔇η: is_cf_adjunction β ?ℭ𝔇 ?𝔇𝔇 ?𝔇𝔊 ?𝔇𝔉 ?adj_𝔇η by (rule exp_adj)
show ?thesis
proof(intro is_cat_rKeI)
have id_𝔇: "cf_map (cf_id 𝔇) ∈⇩∘ cat_FUNCT α 𝔇 𝔇⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_FUNCT_components(1)
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
then have exp_id_𝔇:
"exp_cat_cf α 𝔇 𝔉⦇ObjMap⦈⦇cf_map (cf_id 𝔇)⦈ = cf_map 𝔉"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cs_intro: cat_cs_intros
)
have 𝔉: "cf_map 𝔉 ∈⇩∘ cat_FUNCT α ℭ 𝔇⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_FUNCT_components(1)
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
have ε: "ntcf_arrow (ε⇩C Φ) ∈⇩∘ ntcf_arrows α 𝔇 𝔇"
by (cs_concl cs_intro: cat_FUNCT_cs_intros adj_cs_intros)
have 𝔇𝔇: "category β (cat_FUNCT α 𝔇 𝔇)"
by (cs_concl cs_intro: cat_cs_intros)
have ℭ𝔇: "category β (cat_FUNCT α ℭ 𝔇)"
by (cs_concl cs_intro: cat_cs_intros)
from
ε 𝔉 αβ id_𝔇
𝔇𝔇 ℭ𝔇 LR.is_functor_axioms RL.is_functor_axioms R.cat_cf_id_is_functor
NT.is_iso_ntcf_axioms
have ε_id_𝔇: "ε⇩C ?adj_𝔇η⦇NTMap⦈⦇cf_map (cf_id 𝔇)⦈ = ntcf_arrow ?ε"
by
(
cs_concl
cs_simp:
cat_Set_the_inverse[symmetric]
cat_op_simps
cat_cs_simps
cat_FUNCT_cs_simps
adj_cs_simps
cs_intro:
𝔇η.NT.iso_ntcf_is_arr_isomorphism''
cat_op_intros
adj_cs_intros
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
)
show "universal_arrow_fo ?𝔇𝔊 (cf_map (cf_id 𝔇)) (cf_map 𝔉) (ntcf_arrow ?ε)"
by
(
rule is_cf_adjunction.cf_adjunction_counit_component_is_ua_fo[
OF exp_adj id_𝔇, unfolded exp_id_𝔇 ε_id_𝔇
]
)
qed (cs_concl cs_intro: cat_cs_intros adj_cs_intros)+
qed
lemma (in is_cf_adjunction) cf_adjunction_unit_is_lKe:
shows "η⇩C Φ : cf_id ℭ ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ 𝔊 ∘⇩C⇩F 𝔉 : ℭ ↦⇩C 𝔇 ↦⇩C ℭ"
by
(
rule is_cat_rKe.is_cat_lKe_op
[
OF is_cf_adjunction.cf_adjunction_counit_is_rKe
[
OF is_cf_adjunction_op,
folded op_ntcf_cf_adjunction_unit op_cf_cf_id
],
unfolded
cat_op_simps ntcf_op_ntcf_op_ntcf[OF cf_adjunction_unit_is_ntcf]
]
)
lemma cf_adjunction_if_lKe_preserves:
assumes "η : cf_id 𝔇 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ 𝔉 ∘⇩C⇩F 𝔊 : 𝔇 ↦⇩C ℭ ↦⇩C (𝔊 : 𝔇 ↦↦⇩C ℭ)"
shows "cf_adjunction_of_unit α 𝔊 𝔉 η : 𝔊 ⇌⇩C⇩F 𝔉 : 𝔇 ⇌⇌⇩C⇘α⇙ ℭ"
proof-
interpret η: is_cat_lKe_preserves α 𝔇 ℭ 𝔇 ℭ 𝔊 ‹cf_id 𝔇› 𝔉 𝔊 η
by (rule assms)
from η.cat_lKe_preserves interpret 𝔊η:
is_cat_lKe α 𝔇 ℭ ℭ 𝔊 𝔊 ‹𝔊 ∘⇩C⇩F 𝔉› ‹𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F η›
by (cs_prems cs_simp: cat_cs_simps)
from
𝔊η.cat_lKe_unique
[
OF η.AG.HomCod.cat_cf_id_is_functor,
unfolded η.AG.cf_cf_comp_cf_id_left,
OF η.AG.cf_ntcf_id_is_ntcf
]
obtain ε where ε: "ε : 𝔊 ∘⇩C⇩F 𝔉 ↦⇩C⇩F cf_id ℭ : ℭ ↦↦⇩C⇘α⇙ ℭ"
and ntcf_id_𝔊_def: "ntcf_id 𝔊 = ε ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊 ∙⇩N⇩T⇩C⇩F (𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F η)"
by metis
interpret ε: is_ntcf α ℭ ℭ ‹𝔊 ∘⇩C⇩F 𝔉› ‹cf_id ℭ› ε by (rule ε)
show ?thesis
proof(rule counit_unit_is_cf_adjunction)
show [cat_cs_simps]: "ε ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊 ∙⇩N⇩T⇩C⇩F (𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F η) = ntcf_id 𝔊"
by (rule ntcf_id_𝔊_def[symmetric])
have η_def: "η = (ntcf_id 𝔉 ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊) ∙⇩N⇩T⇩C⇩F η"
by
(
cs_concl
cs_simp: cat_cs_simps ntcf_id_cf_comp[symmetric]
cs_intro: cat_cs_intros
)
note [cat_cs_simps] = this[symmetric]
let ?𝔉ε𝔊 = ‹𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ε ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊›
let ?η𝔉𝔊 = ‹η ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉 ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊›
let ?𝔉𝔊η = ‹𝔉 ∘⇩C⇩F 𝔊 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F η›
have "(?𝔉ε𝔊 ∙⇩N⇩T⇩C⇩F ?η𝔉𝔊) ∙⇩N⇩T⇩C⇩F η = (?𝔉ε𝔊 ∙⇩N⇩T⇩C⇩F ?𝔉𝔊η) ∙⇩N⇩T⇩C⇩F η"
proof(rule ntcf_eqI)
have dom_lhs: "𝒟⇩∘ (((?𝔉ε𝔊 ∙⇩N⇩T⇩C⇩F ?η𝔉𝔊) ∙⇩N⇩T⇩C⇩F η)⦇NTMap⦈) = 𝔇⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have dom_rhs: "𝒟⇩∘ (((?𝔉ε𝔊 ∙⇩N⇩T⇩C⇩F ?𝔉𝔊η) ∙⇩N⇩T⇩C⇩F η)⦇NTMap⦈) = 𝔇⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
note is_ntcf.ntcf_Comp_commute[cat_cs_simps del]
note category.cat_Comp_assoc[cat_cs_simps del]
show
"((?𝔉ε𝔊 ∙⇩N⇩T⇩C⇩F ?η𝔉𝔊) ∙⇩N⇩T⇩C⇩F η)⦇NTMap⦈ =
((?𝔉ε𝔊 ∙⇩N⇩T⇩C⇩F ?𝔉𝔊η) ∙⇩N⇩T⇩C⇩F η)⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ∈⇩∘ 𝔇⦇Obj⦈"
then show
"((?𝔉ε𝔊 ∙⇩N⇩T⇩C⇩F ?η𝔉𝔊) ∙⇩N⇩T⇩C⇩F η)⦇NTMap⦈⦇a⦈ =
((?𝔉ε𝔊 ∙⇩N⇩T⇩C⇩F ?𝔉𝔊η) ∙⇩N⇩T⇩C⇩F η)⦇NTMap⦈⦇a⦈"
by
(
cs_concl
cs_simp: cat_cs_simps η.ntcf_lKe.ntcf_Comp_commute[symmetric]
cs_intro: cat_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros)+
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
also have "… = (ntcf_id 𝔉 ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊) ∙⇩N⇩T⇩C⇩F η"
by
(
cs_concl
cs_simp:
cat_cs_simps
cf_comp_cf_ntcf_comp_assoc
cf_ntcf_comp_ntcf_cf_comp_assoc
cf_ntcf_comp_ntcf_vcomp[symmetric]
cs_intro: cat_cs_intros
)
also have "… = η" by (cs_concl cs_simp: cat_cs_simps)
finally have "(?𝔉ε𝔊 ∙⇩N⇩T⇩C⇩F ?η𝔉𝔊) ∙⇩N⇩T⇩C⇩F η = η" by simp
then have η_def':
"η = (𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ε ∙⇩N⇩T⇩C⇩F (η ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉) ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊) ∙⇩N⇩T⇩C⇩F η"
by
(
cs_concl
cs_simp: cat_cs_simps ntcf_vcomp_ntcf_cf_comp[symmetric]
cs_intro: cat_cs_intros
)+
have 𝔉εη𝔉:
"𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ε ∙⇩N⇩T⇩C⇩F (η ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉) : 𝔉 ↦⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from η.cat_lKe_unique[OF η.Lan.is_functor_axioms η.ntcf_lKe.is_ntcf_axioms]
obtain σ where
"⟦ σ' : 𝔉 ↦⇩C⇩F 𝔉 : ℭ ↦↦⇩C⇘α⇙ 𝔇; η = σ' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊 ∙⇩N⇩T⇩C⇩F η ⟧ ⟹
σ' = σ"
for σ'
by metis
from this[OF η.Lan.cf_ntcf_id_is_ntcf η_def] this[OF 𝔉εη𝔉 η_def'] show
"𝔉 ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ε ∙⇩N⇩T⇩C⇩F (η ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔉) = ntcf_id 𝔉"
by simp
qed (cs_concl cs_intro: cat_cs_intros)+
qed
lemma cf_adjunction_if_rKe_preserves:
assumes "ε : 𝔉 ∘⇩C⇩F 𝔊 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ cf_id 𝔇 : 𝔇 ↦⇩C ℭ ↦⇩C (𝔊 : 𝔇 ↦↦⇩C ℭ)"
shows "cf_adjunction_of_counit α 𝔉 𝔊 ε : 𝔉 ⇌⇩C⇩F 𝔊 : ℭ ⇌⇌⇩C⇘α⇙ 𝔇"
proof-
interpret ε: is_cat_rKe_preserves α 𝔇 ℭ 𝔇 ℭ 𝔊 ‹cf_id 𝔇› 𝔉 𝔊 ε
by (rule assms)
have "op_cf (cf_id 𝔇) = cf_id (op_cat 𝔇)" unfolding cat_op_simps by simp
show ?thesis
by
(
rule is_cf_adjunction.is_cf_adjunction_op
[
OF cf_adjunction_if_lKe_preserves[
OF ε.is_cat_rKe_preserves_op[unfolded op_cf_cf_id]
],
folded cf_adjunction_of_counit_def,
unfolded cat_op_simps
]
)
qed
text‹\newpage›
end
Theory CZH_UCAT_PWKan
section‹Pointwise Kan extensions›
theory CZH_UCAT_PWKan
imports CZH_UCAT_Kan
begin
subsection‹Pointwise Kan extensions›
text‹
The following subsection is based on elements of the
content of section 6.3 in \cite{riehl_category_2016} and
Chapter X-5 in \cite{mac_lane_categories_2010}.
›
locale is_cat_pw_rKe = is_cat_rKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔊 ε
for α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔊 ε +
assumes cat_pw_rKe_preserved: "a ∈⇩∘ 𝔄⦇Obj⦈ ⟹
ε :
𝔊 ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 :
𝔅 ↦⇩C ℭ ↦⇩C (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) : 𝔄 ↦↦⇩C cat_Set α)"
syntax "_is_cat_pw_rKe" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(
‹(_ :/ _ ∘⇩C⇩F _ ↦⇩C⇩F⇩.⇩r⇩K⇩e⇩.⇩p⇩wı _ :/ _ ↦⇩C _ ↦⇩C _)›
[51, 51, 51, 51, 51, 51, 51] 51
)
translations "ε : 𝔊 ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇩.⇩p⇩w⇘α⇙ 𝔗 : 𝔅 ↦⇩C ℭ ↦⇩C 𝔄" ⇌
"CONST is_cat_pw_rKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔊 ε"
locale is_cat_pw_lKe = is_cat_lKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔉 η
for α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔉 η +
assumes cat_pw_lKe_preserved: "a ∈⇩∘ op_cat 𝔄⦇Obj⦈ ⟹
op_ntcf η :
op_cf 𝔉 ∘⇩C⇩F op_cf 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ op_cf 𝔗 :
op_cat 𝔅 ↦⇩C op_cat ℭ ↦⇩C (Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) : op_cat 𝔄 ↦↦⇩C cat_Set α)"
syntax "_is_cat_pw_lKe" :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ bool"
(
‹(_ :/ _ ↦⇩C⇩F⇩.⇩l⇩K⇩e⇩.⇩p⇩wı _ ∘⇩C⇩F _ :/ _ ↦⇩C _ ↦⇩C _)›
[51, 51, 51, 51, 51, 51, 51] 51
)
translations "η : 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇩.⇩p⇩w⇘α⇙ 𝔉 ∘⇩C⇩F 𝔎 : 𝔅 ↦⇩C ℭ ↦⇩C 𝔄" ⇌
"CONST is_cat_pw_lKe α 𝔅 ℭ 𝔄 𝔎 𝔗 𝔉 η"
lemma (in is_cat_pw_rKe) cat_pw_rKe_preserved'[cat_Kan_cs_intros]:
assumes "a ∈⇩∘ 𝔄⦇Obj⦈"
and "𝔄' = 𝔄"
and "ℌ' = Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-)"
and "𝔈' = cat_Set α"
shows "ε : 𝔊 ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 : 𝔅 ↦⇩C ℭ ↦⇩C (ℌ' : 𝔄' ↦↦⇩C 𝔈')"
using assms(1) unfolding assms(2-4) by (rule cat_pw_rKe_preserved)
lemmas [cat_Kan_cs_intros] = is_cat_pw_rKe.cat_pw_rKe_preserved'
lemma (in is_cat_pw_lKe) cat_pw_lKe_preserved'[cat_Kan_cs_intros]:
assumes "a ∈⇩∘ op_cat 𝔄⦇Obj⦈"
and "𝔉' = op_cf 𝔉"
and "𝔎' = op_cf 𝔎"
and "𝔗' = op_cf 𝔗"
and "𝔅' = op_cat 𝔅"
and "ℭ' = op_cat ℭ"
and "𝔄' = op_cat 𝔄"
and "ℌ' = Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a)"
and "𝔈' = cat_Set α"
shows "op_ntcf η :
𝔉' ∘⇩C⇩F 𝔎' ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗' : 𝔅' ↦⇩C ℭ' ↦⇩C (ℌ' : 𝔄' ↦↦⇩C 𝔈')"
using assms(1) unfolding assms by (rule cat_pw_lKe_preserved)
lemmas [cat_Kan_cs_intros] = is_cat_pw_lKe.cat_pw_lKe_preserved'
text‹Rules.›
lemma (in is_cat_pw_rKe) is_cat_pw_rKe_axioms'[cat_Kan_cs_intros]:
assumes "α' = α"
and "𝔊' = 𝔊"
and "𝔎' = 𝔎"
and "𝔗' = 𝔗"
and "𝔅' = 𝔅"
and "𝔄' = 𝔄"
and "ℭ' = ℭ"
shows "ε : 𝔊' ∘⇩C⇩F 𝔎' ↦⇩C⇩F⇩.⇩r⇩K⇩e⇩.⇩p⇩w⇘α'⇙ 𝔗' : 𝔅' ↦⇩C ℭ' ↦⇩C 𝔄'"
unfolding assms by (rule is_cat_pw_rKe_axioms)
mk_ide rf is_cat_pw_rKe_def[unfolded is_cat_pw_rKe_axioms_def]
|intro is_cat_pw_rKeI|
|dest is_cat_pw_rKeD[dest]|
|elim is_cat_pw_rKeE[elim]|
lemmas [cat_Kan_cs_intros] = is_cat_pw_rKeD(1)
lemma (in is_cat_pw_lKe) is_cat_pw_lKe_axioms'[cat_Kan_cs_intros]:
assumes "α' = α"
and "𝔉' = 𝔉"
and "𝔎' = 𝔎"
and "𝔗' = 𝔗"
and "𝔅' = 𝔅"
and "𝔄' = 𝔄"
and "ℭ' = ℭ"
shows "η : 𝔗' ↦⇩C⇩F⇩.⇩l⇩K⇩e⇩.⇩p⇩w⇘α'⇙ 𝔉' ∘⇩C⇩F 𝔎' : 𝔅' ↦⇩C ℭ' ↦⇩C 𝔄'"
unfolding assms by (rule is_cat_pw_lKe_axioms)
mk_ide rf is_cat_pw_lKe_def[unfolded is_cat_pw_lKe_axioms_def]
|intro is_cat_pw_lKeI|
|dest is_cat_pw_lKeD[dest]|
|elim is_cat_pw_lKeE[elim]|
lemmas [cat_Kan_cs_intros] = is_cat_pw_lKeD(1)
text‹Duality.›
lemma (in is_cat_pw_rKe) is_cat_pw_lKe_op:
"op_ntcf ε :
op_cf 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇩.⇩p⇩w⇘α⇙ op_cf 𝔊 ∘⇩C⇩F op_cf 𝔎 :
op_cat 𝔅 ↦⇩C op_cat ℭ ↦⇩C op_cat 𝔄"
proof(intro is_cat_pw_lKeI, unfold cat_op_simps)
fix a assume prems: "a ∈⇩∘ 𝔄⦇Obj⦈"
from cat_pw_rKe_preserved[OF prems] prems show
"ε :
𝔊 ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 :
𝔅 ↦⇩C ℭ ↦⇩C (Hom⇩O⇩.⇩C⇘α⇙op_cat 𝔄(-,a) : 𝔄 ↦↦⇩C cat_Set α)"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
qed (cs_concl cs_intro: cat_op_intros)
lemma (in is_cat_pw_rKe) is_cat_pw_lKe_op'[cat_op_intros]:
assumes "𝔗' = op_cf 𝔗"
and "𝔊' = op_cf 𝔊"
and "𝔎' = op_cf 𝔎"
and "𝔅' = op_cat 𝔅"
and "𝔄' = op_cat 𝔄"
and "ℭ' = op_cat ℭ"
shows "op_ntcf ε : 𝔗' ↦⇩C⇩F⇩.⇩l⇩K⇩e⇩.⇩p⇩w⇘α⇙ 𝔊' ∘⇩C⇩F 𝔎' : 𝔅' ↦⇩C ℭ' ↦⇩C 𝔄'"
unfolding assms by (rule is_cat_pw_lKe_op)
lemmas [cat_op_intros] = is_cat_pw_rKe.is_cat_pw_lKe_op'
lemma (in is_cat_pw_lKe) is_cat_pw_rKe_op:
"op_ntcf η :
op_cf 𝔉 ∘⇩C⇩F op_cf 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇩.⇩p⇩w⇘α⇙ op_cf 𝔗 :
op_cat 𝔅 ↦⇩C op_cat ℭ ↦⇩C op_cat 𝔄"
proof(intro is_cat_pw_rKeI, unfold cat_op_simps)
fix a assume prems: "a ∈⇩∘ 𝔄⦇Obj⦈"
from cat_pw_lKe_preserved[unfolded cat_op_simps, OF prems] prems show
"op_ntcf η :
op_cf 𝔉 ∘⇩C⇩F op_cf 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ op_cf 𝔗 :
op_cat 𝔅 ↦⇩C op_cat ℭ ↦⇩C
(Hom⇩O⇩.⇩C⇘α⇙op_cat 𝔄(a,-) : op_cat 𝔄 ↦↦⇩C cat_Set α)"
by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)
qed (cs_concl cs_intro: cat_op_intros)
lemma (in is_cat_pw_lKe) is_cat_pw_lKe_op'[cat_op_intros]:
assumes "𝔗' = op_cf 𝔗"
and "𝔉' = op_cf 𝔉"
and "𝔎' = op_cf 𝔎"
and "𝔅' = op_cat 𝔅"
and "𝔄' = op_cat 𝔄"
and "ℭ' = op_cat ℭ"
shows "op_ntcf η : 𝔉' ∘⇩C⇩F 𝔎' ↦⇩C⇩F⇩.⇩r⇩K⇩e⇩.⇩p⇩w⇘α⇙ 𝔗' : 𝔅' ↦⇩C ℭ' ↦⇩C 𝔄'"
unfolding assms by (rule is_cat_pw_rKe_op)
lemmas [cat_op_intros] = is_cat_pw_lKe.is_cat_pw_lKe_op'
subsection‹Cone functor›
subsubsection‹Definition and elementary properties›
definition cf_Cone :: "V ⇒ V ⇒ V ⇒ V"
where "cf_Cone α β 𝔉 =
Hom⇩O⇩.⇩C⇘β⇙cat_Funct α (𝔉⦇HomDom⦈) (𝔉⦇HomCod⦈)(-,cf_map 𝔉) ∘⇩C⇩F
op_cf (Δ⇩C α (𝔉⦇HomDom⦈) (𝔉⦇HomCod⦈))"
text‹An alternative form of the definition.›
context is_functor
begin
lemma cf_Cone_def':
"cf_Cone α β 𝔉 = Hom⇩O⇩.⇩C⇘β⇙cat_Funct α 𝔄 𝔅(-,cf_map 𝔉) ∘⇩C⇩F op_cf (Δ⇩C α 𝔄 𝔅)"
unfolding cf_Cone_def cat_cs_simps by simp
end
subsubsection‹Object map›
lemma (in is_tm_functor) cf_Cone_ObjMap_vsv[cat_Kan_cs_intros]:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "vsv (cf_Cone α β 𝔉⦇ObjMap⦈)"
proof-
from assms interpret β: 𝒵 β by simp
from assms interpret Δ: is_functor α 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹Δ⇩C α 𝔄 𝔅›
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Δ.is_functor_axioms assms(2) interpret βΔ:
is_functor β 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹Δ⇩C α 𝔄 𝔅›
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from assms(2) show ?thesis
unfolding cf_Cone_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
)
qed
lemmas [cat_Kan_cs_intros] = is_tm_functor.cf_Cone_ObjMap_vsv
lemma (in is_tm_functor) cf_Cone_ObjMap_vdomain[cat_Kan_cs_simps]:
assumes "𝒵 β" and "α ∈⇩∘ β" and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows "𝒟⇩∘ (cf_Cone α β 𝔉⦇ObjMap⦈) = 𝔅⦇Obj⦈"
proof-
from assms interpret β: 𝒵 β by simp
from assms interpret Δ: is_functor α 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹Δ⇩C α 𝔄 𝔅›
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Δ.is_functor_axioms assms(2) interpret βΔ:
is_functor β 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹Δ⇩C α 𝔄 𝔅›
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from assms(2) show ?thesis
unfolding cf_Cone_def'
by
(
cs_concl
cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
)
qed
lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ObjMap_vdomain
lemma (in is_tm_functor) cf_Cone_ObjMap_app[cat_Kan_cs_simps]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows "cf_Cone α β 𝔉⦇ObjMap⦈⦇b⦈ =
Hom (cat_Funct α 𝔄 𝔅) (cf_map (cf_const 𝔄 𝔅 b)) (cf_map 𝔉)"
proof-
from assms interpret β: 𝒵 β by simp
from assms interpret Δ: is_functor α 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹Δ⇩C α 𝔄 𝔅›
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Δ.is_functor_axioms assms(2) interpret βΔ:
is_functor β 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹Δ⇩C α 𝔄 𝔅›
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from assms(2,3) show ?thesis
unfolding cf_Cone_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
)
qed
lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ObjMap_app
subsubsection‹Arrow map›
lemma (in is_tm_functor) cf_Cone_ArrMap_vsv[cat_Kan_cs_intros]:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "vsv (cf_Cone α β 𝔉⦇ArrMap⦈)"
proof-
from assms interpret β: 𝒵 β by simp
from assms interpret Δ: is_functor α 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹Δ⇩C α 𝔄 𝔅›
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Δ.is_functor_axioms assms(2) interpret βΔ:
is_functor β 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹Δ⇩C α 𝔄 𝔅›
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from assms(2) show ?thesis
unfolding cf_Cone_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
)
qed
lemmas [cat_Kan_cs_intros] = is_tm_functor.cf_Cone_ArrMap_vsv
lemma (in is_tm_functor) cf_Cone_ArrMap_vdomain[cat_Kan_cs_simps]:
assumes "𝒵 β" and "α ∈⇩∘ β" and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows "𝒟⇩∘ (cf_Cone α β 𝔉⦇ArrMap⦈) = 𝔅⦇Arr⦈"
proof-
from assms interpret β: 𝒵 β by simp
from assms interpret Δ: is_functor α 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹Δ⇩C α 𝔄 𝔅›
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Δ.is_functor_axioms assms(2) interpret βΔ:
is_functor β 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹Δ⇩C α 𝔄 𝔅›
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from assms(2) show ?thesis
unfolding cf_Cone_def'
by
(
cs_concl
cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
)
qed
lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ArrMap_vdomain
lemma (in is_tm_functor) cf_Cone_ArrMap_app[cat_Kan_cs_simps]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "f : a ↦⇘𝔅⇙ b"
shows "cf_Cone α β 𝔉⦇ArrMap⦈⦇f⦈ = cf_hom
(cat_Funct α 𝔄 𝔅)
[ntcf_arrow (ntcf_const 𝔄 𝔅 f), cat_Funct α 𝔄 𝔅⦇CId⦈⦇cf_map 𝔉⦈]⇩∘"
proof-
from assms interpret β: 𝒵 β by simp
from assms interpret Δ: is_functor α 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹Δ⇩C α 𝔄 𝔅›
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Δ.is_functor_axioms assms(2) interpret βΔ:
is_functor β 𝔅 ‹cat_Funct α 𝔄 𝔅› ‹Δ⇩C α 𝔄 𝔅›
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from assms(2,3) show ?thesis
unfolding cf_Cone_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Funct_components(1) cat_op_simps
cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros cat_op_intros
)
qed
lemmas [cat_Kan_cs_simps] = is_tm_functor.cf_Cone_ArrMap_app
subsubsection‹The cone functor is a functor›
lemma (in is_tm_functor) tm_cf_cf_Cone_is_functor:
"cf_Cone α α 𝔉 : op_cat 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
unfolding cf_Cone_def'
by
(
cs_concl
cs_simp: cat_op_simps cat_Funct_components(1)
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
)
lemma (in is_tm_functor) tm_cf_cf_Cone_is_functor_if_ge_Limit:
assumes "𝒵 β" and "α ∈⇩∘ β"
shows "cf_Cone α β 𝔉 : op_cat 𝔅 ↦↦⇩C⇘β⇙ cat_Set β"
proof-
from assms interpret 𝔄𝔅: category α ‹cat_Funct α 𝔄 𝔅›
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
interpret β_𝔄𝔅: category β ‹cat_Funct α 𝔄 𝔅›
by (rule 𝔄𝔅.cat_category_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros assms)+
from assms interpret op_Δ:
is_tiny_functor β ‹op_cat 𝔅› ‹op_cat (cat_Funct α 𝔄 𝔅)› ‹op_cf (Δ⇩C α 𝔄 𝔅)›
by (intro is_functor.cf_is_tiny_functor_if_ge_Limit)
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
have "Hom⇩O⇩.⇩C⇘β⇙cat_Funct α 𝔄 𝔅(-,cf_map 𝔉) :
op_cat (cat_Funct α 𝔄 𝔅) ↦↦⇩C⇘β⇙ cat_Set β"
by
(
cs_concl
cs_simp: cat_Funct_components(1)
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
then show "cf_Cone α β 𝔉 : op_cat 𝔅 ↦↦⇩C⇘β⇙ cat_Set β"
unfolding cf_Cone_def'
by (cs_concl cs_intro: cat_cs_intros)
qed
subsection‹Lemma X.5: ‹L_10_5_N›\label{sec:lem_X_5_start}›
text‹
This subsection and several further subsections
(\ref{sec:lem_X_5_start}-\ref{sec:lem_X_5_end})
expose definitions that are used in the proof of the technical lemma that
was used in the proof of Theorem 3 from Chapter X-5
in \cite{mac_lane_categories_2010}.
›
definition L_10_5_N :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "L_10_5_N α β 𝔗 𝔎 c =
[
(
λa∈⇩∘𝔗⦇HomCod⦈⦇Obj⦈.
cf_nt α β 𝔎⦇ObjMap⦈⦇cf_map (Hom⇩O⇩.⇩C⇘α⇙𝔗⦇HomCod⦈(a,-) ∘⇩C⇩F 𝔗), c⦈⇩∙
),
(
λf∈⇩∘𝔗⦇HomCod⦈⦇Arr⦈.
cf_nt α β 𝔎⦇ArrMap⦈⦇
ntcf_arrow (Hom⇩A⇩.⇩C⇘α⇙𝔗⦇HomCod⦈(f,-) ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔗), 𝔎⦇HomCod⦈⦇CId⦈⦇c⦈
⦈⇩∙
),
op_cat (𝔗⦇HomCod⦈),
cat_Set β
]⇩∘"
text‹Components.›
lemma L_10_5_N_components:
shows "L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈ =
(
λa∈⇩∘𝔗⦇HomCod⦈⦇Obj⦈.
cf_nt α β 𝔎⦇ObjMap⦈⦇cf_map (Hom⇩O⇩.⇩C⇘α⇙𝔗⦇HomCod⦈(a,-) ∘⇩C⇩F 𝔗), c⦈⇩∙
)"
and "L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈ =
(
λf∈⇩∘𝔗⦇HomCod⦈⦇Arr⦈.
cf_nt α β 𝔎⦇ArrMap⦈⦇
ntcf_arrow (Hom⇩A⇩.⇩C⇘α⇙𝔗⦇HomCod⦈(f,-) ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔗), 𝔎⦇HomCod⦈⦇CId⦈⦇c⦈
⦈⇩∙
)"
and "L_10_5_N α β 𝔗 𝔎 c⦇HomDom⦈ = op_cat (𝔗⦇HomCod⦈)"
and "L_10_5_N α β 𝔗 𝔎 c⦇HomCod⦈ = cat_Set β"
unfolding L_10_5_N_def dghm_field_simps by (simp_all add: nat_omega_simps)
context
fixes α 𝔅 ℭ 𝔄 𝔎 𝔗
assumes 𝔎: "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)
lemmas L_10_5_N_components' = L_10_5_N_components[
where 𝔗=𝔗 and 𝔎=𝔎, unfolded cat_cs_simps
]
lemmas [cat_Kan_cs_simps] = L_10_5_N_components'(3,4)
end
subsubsection‹Object map›
mk_VLambda L_10_5_N_components(1)
|vsv L_10_5_N_ObjMap_vsv[cat_Kan_cs_intros]|
context
fixes α 𝔅 ℭ 𝔄 𝔎 𝔗 c
assumes 𝔎: "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
mk_VLambda L_10_5_N_components'(1)[OF 𝔎 𝔗]
|vdomain L_10_5_N_ObjMap_vdomain[cat_Kan_cs_simps]|
|app L_10_5_N_ObjMap_app[cat_Kan_cs_simps]|
end
subsubsection‹Arrow map›
mk_VLambda L_10_5_N_components(2)
|vsv L_10_5_N_ArrMap_vsv[cat_Kan_cs_intros]|
context
fixes α 𝔅 ℭ 𝔄 𝔎 𝔗 c
assumes 𝔎: "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
mk_VLambda L_10_5_N_components'(2)[OF 𝔎 𝔗]
|vdomain L_10_5_N_ArrMap_vdomain[cat_Kan_cs_simps]|
|app L_10_5_N_ArrMap_app[cat_Kan_cs_simps]|
end
subsubsection‹‹L_10_5_N› is a functor›
lemma L_10_5_N_is_functor:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
shows "L_10_5_N α β 𝔗 𝔎 c : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
proof-
let ?FUNCT = ‹λ𝔄. cat_FUNCT α 𝔄 (cat_Set α)›
interpret β: 𝒵 β by (rule assms(1))
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(3))
interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(4))
from assms(2) interpret FUNCT_𝔅: tiny_category β ‹?FUNCT 𝔅›
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
interpret β𝔎: is_tiny_functor β 𝔅 ℭ 𝔎
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_intro: cat_cs_intros›)+
interpret β𝔗: is_tiny_functor β 𝔅 𝔄 𝔗
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_intro: cat_cs_intros›)+
from assms(2) interpret cf_nt:
is_functor β ‹?FUNCT 𝔅 ×⇩C ℭ› ‹cat_Set β› ‹cf_nt α β 𝔎›
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show ?thesis
proof(intro is_functorI')
show "vfsequence (L_10_5_N α β 𝔗 𝔎 c)" unfolding L_10_5_N_def by simp
show "vcard (L_10_5_N α β 𝔗 𝔎 c) = 4⇩ℕ"
unfolding L_10_5_N_def by (simp add: nat_omega_simps)
show "vsv (L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈)"
by (cs_concl cs_intro: cat_Kan_cs_intros)
from assms(3,4) show "vsv (L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈)"
by (cs_concl cs_intro: cat_Kan_cs_intros)
from assms show "𝒟⇩∘ (L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈) = op_cat 𝔄⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_op_simps cs_intro: cat_cs_intros
)
show "ℛ⇩∘ (L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈) ⊆⇩∘ cat_Set β⦇Obj⦈"
unfolding L_10_5_N_components'[OF 𝔎.is_functor_axioms 𝔗.is_functor_axioms]
proof(rule vrange_VLambda_vsubset)
fix a assume prems: "a ∈⇩∘ 𝔄⦇Obj⦈"
from prems assms show
"cf_nt α β 𝔎⦇ObjMap⦈⦇cf_map (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗), c⦈⇩∙ ∈⇩∘
cat_Set β⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_Set_components(1) cat_cs_simps cat_FUNCT_cs_simps
cs_intro:
cat_cs_intros FUNCT_𝔅.cat_Hom_in_Vset cat_FUNCT_cs_intros
)
qed
from assms show "𝒟⇩∘ (L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈) = op_cat 𝔄⦇Arr⦈"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_op_simps cs_intro: cat_cs_intros
)
show "L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈⦇f⦈ :
L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set β⇙ L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇b⦈"
if "f : a ↦⇘op_cat 𝔄⇙ b" for a b f
using that assms
unfolding cat_op_simps
by
(
cs_concl
cs_simp: L_10_5_N_ArrMap_app L_10_5_N_ObjMap_app
cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
)
show
"L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈⦇g ∘⇩A⇘op_cat 𝔄⇙ f⦈ =
L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈⦇g⦈ ∘⇩A⇘cat_Set β⇙ L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈⦇f⦈"
if "g : b' ↦⇘op_cat 𝔄⇙ c'" and "f : a' ↦⇘op_cat 𝔄⇙ b'" for b' c' g a' f
proof-
from that assms(5) show ?thesis
unfolding cat_op_simps
by
(
cs_concl
cs_intro:
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_FUNCT_cs_simps
cat_prod_cs_simps
cat_op_simps
cf_nt.cf_ArrMap_Comp[symmetric]
)
qed
show
"L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈⦇op_cat 𝔄⦇CId⦈⦇a⦈⦈ =
cat_Set β⦇CId⦈⦇L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈⦈"
if "a ∈⇩∘ op_cat 𝔄⦇Obj⦈" for a
proof-
note [cat_cs_simps] =
ntcf_id_cf_comp[symmetric]
ntcf_arrow_id_ntcf_id[symmetric]
cat_FUNCT_CId_app[symmetric]
from that[unfolded cat_op_simps] assms show ?thesis
by
(
cs_concl
cs_intro:
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
cs_simp:
cat_FUNCT_cs_simps cat_cs_simps cat_Kan_cs_simps cat_op_simps
)
qed
qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+
qed
lemma L_10_5_N_is_functor'[cat_Kan_cs_intros]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and "𝔄' = op_cat 𝔄"
and "𝔅' = cat_Set β"
and "β' = β"
shows "L_10_5_N α β 𝔗 𝔎 c : 𝔄' ↦↦⇩C⇘β'⇙ 𝔅'"
using assms(1-5) unfolding assms(6-8) by (rule L_10_5_N_is_functor)
subsection‹Lemma X.5: ‹L_10_5_υ_arrow››
subsubsection‹Definition and elementary properties›
definition L_10_5_υ_arrow :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "L_10_5_υ_arrow 𝔗 𝔎 c τ a b =
[
(λf∈⇩∘Hom (𝔎⦇HomCod⦈) c (𝔎⦇ObjMap⦈⦇b⦈). τ⦇NTMap⦈⦇0, b, f⦈⇩∙),
Hom (𝔎⦇HomCod⦈) c (𝔎⦇ObjMap⦈⦇b⦈),
Hom (𝔗⦇HomCod⦈) a (𝔗⦇ObjMap⦈⦇b⦈)
]⇩∘"
text‹Components.›
lemma L_10_5_υ_arrow_components:
shows "L_10_5_υ_arrow 𝔗 𝔎 c τ a b⦇ArrVal⦈ =
(λf∈⇩∘Hom (𝔎⦇HomCod⦈) c (𝔎⦇ObjMap⦈⦇b⦈). τ⦇NTMap⦈⦇0, b, f⦈⇩∙)"
and "L_10_5_υ_arrow 𝔗 𝔎 c τ a b⦇ArrDom⦈ = Hom (𝔎⦇HomCod⦈) c (𝔎⦇ObjMap⦈⦇b⦈)"
and "L_10_5_υ_arrow 𝔗 𝔎 c τ a b⦇ArrCod⦈ = Hom (𝔗⦇HomCod⦈) a (𝔗⦇ObjMap⦈⦇b⦈)"
unfolding L_10_5_υ_arrow_def arr_field_simps
by (simp_all add: nat_omega_simps)
context
fixes α 𝔅 ℭ 𝔄 𝔎 𝔗
assumes 𝔎: "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)
lemmas L_10_5_υ_arrow_components' = L_10_5_υ_arrow_components[
where 𝔗=𝔗 and 𝔎=𝔎, unfolded cat_cs_simps
]
lemmas [cat_Kan_cs_simps] = L_10_5_υ_arrow_components'(2,3)
end
subsubsection‹Arrow value›
mk_VLambda L_10_5_υ_arrow_components(1)
|vsv L_10_5_υ_arrow_ArrVal_vsv[cat_Kan_cs_intros]|
context
fixes α 𝔅 ℭ 𝔄 𝔎 𝔗
assumes 𝔎: "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
mk_VLambda L_10_5_υ_arrow_components'(1)[OF 𝔎 𝔗]
|vdomain L_10_5_υ_arrow_ArrVal_vdomain[cat_Kan_cs_simps]|
|app L_10_5_υ_arrow_ArrVal_app[unfolded in_Hom_iff]|
end
lemma L_10_5_υ_arrow_ArrVal_app':
assumes "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "f : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
shows "L_10_5_υ_arrow 𝔗 𝔎 c τ a b⦇ArrVal⦈⦇f⦈ = τ⦇NTMap⦈⦇0, b, f⦈⇩∙"
proof-
interpret 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
from assms(3) have c: "c ∈⇩∘ ℭ⦇Obj⦈" by auto
show ?thesis by (rule L_10_5_υ_arrow_ArrVal_app[OF assms(1,2,3)])
qed
subsubsection‹‹L_10_5_υ_arrow› is an arrow›
lemma L_10_5_υ_arrow_ArrVal_is_arr:
assumes "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "τ' = ntcf_arrow τ"
and "τ : a <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and "f : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows "L_10_5_υ_arrow 𝔗 𝔎 c τ' a b⦇ArrVal⦈⦇f⦈ : a ↦⇘𝔄⇙ 𝔗⦇ObjMap⦈⦇b⦈"
proof-
interpret 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
interpret τ: is_cat_cone α a ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› τ by (rule assms(4))
from assms(5,6) show ?thesis
unfolding assms(3)
by
(
cs_concl
cs_simp:
cat_cs_simps
L_10_5_υ_arrow_ArrVal_app
cat_comma_cs_simps
cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
lemma L_10_5_υ_arrow_ArrVal_is_arr'[cat_Kan_cs_intros]:
assumes "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "τ' = ntcf_arrow τ"
and "a' = a"
and "b' = 𝔗⦇ObjMap⦈⦇b⦈"
and "𝔄' = 𝔄"
and "τ : a <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and "f : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows "L_10_5_υ_arrow 𝔗 𝔎 c τ' a b⦇ArrVal⦈⦇f⦈ : a' ↦⇘𝔄⇙ b'"
using assms(1-3, 7-9)
unfolding assms(3-6)
by (rule L_10_5_υ_arrow_ArrVal_is_arr)
subsubsection‹Further elementary properties›
lemma L_10_5_υ_arrow_is_arr:
assumes "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and "τ' = ntcf_arrow τ"
and "τ : a <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
shows "L_10_5_υ_arrow 𝔗 𝔎 c τ' a b :
Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙ Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b⦈)"
proof-
note L_10_5_υ_arrow_components = L_10_5_υ_arrow_components'[OF assms(1,2)]
interpret 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
interpret τ: is_cat_cone α a ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› τ by (rule assms(5))
show ?thesis
proof(intro cat_Set_is_arrI)
show "arr_Set α (L_10_5_υ_arrow 𝔗 𝔎 c τ' a b)"
proof(intro arr_SetI)
show "vfsequence (L_10_5_υ_arrow 𝔗 𝔎 c τ' a b)"
unfolding L_10_5_υ_arrow_def by simp
show "vcard (L_10_5_υ_arrow 𝔗 𝔎 c τ' a b) = 3⇩ℕ"
unfolding L_10_5_υ_arrow_def by (simp add: nat_omega_simps)
show
"ℛ⇩∘ (L_10_5_υ_arrow 𝔗 𝔎 c τ' a b⦇ArrVal⦈) ⊆⇩∘
L_10_5_υ_arrow 𝔗 𝔎 c τ' a b⦇ArrCod⦈"
unfolding L_10_5_υ_arrow_components
proof(intro vrange_VLambda_vsubset, unfold in_Hom_iff)
fix f assume "f : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
from L_10_5_υ_arrow_ArrVal_is_arr[OF assms(1,2,4,5) this assms(6)] this
show "τ'⦇NTMap⦈⦇0, b, f⦈⇩∙ : a ↦⇘𝔄⇙ 𝔗⦇ObjMap⦈⦇b⦈"
by
(
cs_prems
cs_simp: L_10_5_υ_arrow_ArrVal_app' cat_cs_simps
cs_intro: cat_cs_intros
)
qed
from assms(3,6) show "L_10_5_υ_arrow 𝔗 𝔎 c τ' a b⦇ArrDom⦈ ∈⇩∘ Vset α"
by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
from assms(1-3,6) τ.cat_cone_obj show
"L_10_5_υ_arrow 𝔗 𝔎 c τ' a b⦇ArrCod⦈ ∈⇩∘ Vset α"
by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
qed (auto simp: L_10_5_υ_arrow_components)
qed (simp_all add: L_10_5_υ_arrow_components)
qed
lemma L_10_5_υ_arrow_is_arr'[cat_Kan_cs_intros]:
assumes "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and "τ' = ntcf_arrow τ"
and "τ : a <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and "b ∈⇩∘ 𝔅⦇Obj⦈"
and "A = Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈)"
and "B = Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b⦈)"
and "ℭ' = cat_Set α"
shows "L_10_5_υ_arrow 𝔗 𝔎 c τ' a b : A ↦⇘ℭ'⇙ B"
using assms(1-6) unfolding assms(7-9) by (rule L_10_5_υ_arrow_is_arr)
lemma L_10_5_υ_cf_hom[cat_Kan_cs_simps]:
assumes "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and "τ' = ntcf_arrow τ"
and "τ : a <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and "a ∈⇩∘ 𝔄⦇Obj⦈"
and "f : a' ↦⇘𝔅⇙ b'"
shows
"L_10_5_υ_arrow 𝔗 𝔎 c τ' a b' ∘⇩A⇘cat_Set α⇙
cf_hom ℭ [ℭ⦇CId⦈⦇c⦈, 𝔎⦇ArrMap⦈⦇f⦈]⇩∘ =
cf_hom 𝔄 [𝔄⦇CId⦈⦇a⦈, 𝔗⦇ArrMap⦈⦇f⦈]⇩∘ ∘⇩A⇘cat_Set α⇙
L_10_5_υ_arrow 𝔗 𝔎 c τ' a a'"
(is "?lhs = ?rhs")
proof-
interpret 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
interpret τ: is_cat_cone α a ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› τ by (rule assms(5))
have [cat_Kan_cs_simps]:
"τ⦇NTMap⦈⦇a'', b'', 𝔎⦇ArrMap⦈⦇h'⦈ ∘⇩A⇘ℭ⇙ f'⦈⇩∙ =
𝔗⦇ArrMap⦈⦇h'⦈ ∘⇩A⇘𝔄⇙ τ⦇NTMap⦈⦇a', b', f'⦈⇩∙"
if F_def: "F = [[a', b', f']⇩∘, [a'', b'', f'']⇩∘, [g', h']⇩∘]⇩∘"
and A_def: "A = [a', b', f']⇩∘"
and B_def: "B = [a'', b'', f'']⇩∘"
and F: "F : A ↦⇘c ↓⇩C⇩F 𝔎⇙ B"
for F A B a' b' f' a'' b'' f'' g' h'
proof-
from F[unfolded F_def A_def B_def] assms(3) have a'_def: "a' = 0"
and a''_def: "a'' = 0"
and g'_def: "g' = 0"
and h': "h' : b' ↦⇘𝔅⇙ b''"
and f': "f' : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
and f'': "f'' : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b''⦈"
and f''_def: "𝔎⦇ArrMap⦈⦇h'⦈ ∘⇩A⇘ℭ⇙ f' = f''"
by auto
from
τ.ntcf_Comp_commute[OF F]
that(2) F g' h' f' f''
𝔎.is_functor_axioms
𝔗.is_functor_axioms
show
"τ⦇NTMap⦈⦇a'', b'', 𝔎⦇ArrMap⦈⦇h'⦈ ∘⇩A⇘ℭ⇙ f'⦈⇩∙ =
𝔗⦇ArrMap⦈⦇h'⦈ ∘⇩A⇘𝔄⇙ τ⦇NTMap⦈⦇a', b', f'⦈⇩∙"
unfolding F_def A_def B_def a'_def a''_def g'_def
by
(
cs_prems 1
cs_simp: cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
from assms(3) assms(6,7) 𝔎.HomCod.category_axioms have lhs_is_arr:
"?lhs : Hom ℭ c (𝔎⦇ObjMap⦈⦇a'⦈) ↦⇘cat_Set α⇙ Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b'⦈)"
unfolding assms(4)
by
(
cs_concl cs_simp: cs_intro:
cat_lim_cs_intros
cat_cs_intros
cat_Kan_cs_intros
cat_prod_cs_intros
cat_op_intros
)
then have dom_lhs: "𝒟⇩∘ ((?lhs)⦇ArrVal⦈) = Hom ℭ c (𝔎⦇ObjMap⦈⦇a'⦈)"
by (cs_concl cs_simp: cat_cs_simps)
from assms(3) assms(6,7) 𝔎.HomCod.category_axioms 𝔗.HomCod.category_axioms
have rhs_is_arr:
"?rhs : Hom ℭ c (𝔎⦇ObjMap⦈⦇a'⦈) ↦⇘cat_Set α⇙ Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b'⦈)"
unfolding assms(4)
by
(
cs_concl cs_intro:
cat_lim_cs_intros
cat_cs_intros
cat_Kan_cs_intros
cat_prod_cs_intros
cat_op_intros
)
then have dom_rhs: "𝒟⇩∘ ((?rhs)⦇ArrVal⦈) = Hom ℭ c (𝔎⦇ObjMap⦈⦇a'⦈)"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI)
from lhs_is_arr show arr_Set_lhs: "arr_Set α ?lhs"
by (auto dest: cat_Set_is_arrD(1))
from rhs_is_arr show arr_Set_rhs: "arr_Set α ?rhs"
by (auto dest: cat_Set_is_arrD(1))
show "?lhs⦇ArrVal⦈ = ?rhs⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix g assume prems: "g : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇a'⦈"
from prems assms(7) have 𝔎f:
"𝔎⦇ArrMap⦈⦇f⦈ ∘⇩A⇘ℭ⇙ g : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b'⦈"
by (cs_concl cs_intro: cat_cs_intros)
with assms(6,7) prems 𝔎.HomCod.category_axioms 𝔗.HomCod.category_axioms
show "?lhs⦇ArrVal⦈⦇g⦈ = ?rhs⦇ArrVal⦈⦇g⦈"
by
(
cs_concl
cs_intro:
cat_lim_cs_intros
cat_cs_intros
cat_Kan_cs_intros
cat_comma_cs_intros
cat_prod_cs_intros
cat_op_intros
cat_1_is_arrI
cs_simp:
L_10_5_υ_arrow_ArrVal_app'
cat_cs_simps
cat_Kan_cs_simps
cat_op_simps
cat_FUNCT_cs_simps
cat_comma_cs_simps
assms(4)
)+
qed (use arr_Set_lhs arr_Set_rhs in auto)
qed
(
use lhs_is_arr rhs_is_arr in
‹cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros›
)+
qed
subsection‹Lemma X.5: ‹L_10_5_τ››
subsubsection‹Definition and elementary properties›
definition L_10_5_τ where "L_10_5_τ 𝔗 𝔎 c υ a =
[
(λbf∈⇩∘c ↓⇩C⇩F 𝔎⦇Obj⦈. υ⦇NTMap⦈⦇bf⦇1⇩ℕ⦈⦈⦇ArrVal⦈⦇bf⦇2⇩ℕ⦈⦈),
cf_const (c ↓⇩C⇩F 𝔎) (𝔗⦇HomCod⦈) a,
𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎,
c ↓⇩C⇩F 𝔎,
(𝔗⦇HomCod⦈)
]⇩∘"
text‹Components.›
lemma L_10_5_τ_components:
shows "L_10_5_τ 𝔗 𝔎 c υ a⦇NTMap⦈ =
(λbf∈⇩∘c ↓⇩C⇩F 𝔎⦇Obj⦈. υ⦇NTMap⦈⦇bf⦇1⇩ℕ⦈⦈⦇ArrVal⦈⦇bf⦇2⇩ℕ⦈⦈)"
and "L_10_5_τ 𝔗 𝔎 c υ a⦇NTDom⦈ = cf_const (c ↓⇩C⇩F 𝔎) (𝔗⦇HomCod⦈) a"
and "L_10_5_τ 𝔗 𝔎 c υ a⦇NTCod⦈ = 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎"
and "L_10_5_τ 𝔗 𝔎 c υ a⦇NTDGDom⦈ = c ↓⇩C⇩F 𝔎"
and "L_10_5_τ 𝔗 𝔎 c υ a⦇NTDGCod⦈ = (𝔗⦇HomCod⦈)"
unfolding L_10_5_τ_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes α 𝔅 ℭ 𝔄 𝔎 𝔗
assumes 𝔎: "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)
lemmas L_10_5_τ_components' = L_10_5_τ_components[
where 𝔗=𝔗 and 𝔎=𝔎, unfolded cat_cs_simps
]
lemmas [cat_Kan_cs_simps] = L_10_5_τ_components'(2-5)
end
subsubsection‹Natural transformation map›
mk_VLambda L_10_5_τ_components(1)
|vsv L_10_5_τ_NTMap_vsv[cat_Kan_cs_intros]|
|vdomain L_10_5_τ_NTMap_vdomain[cat_Kan_cs_simps]|
lemma L_10_5_τ_NTMap_app[cat_Kan_cs_simps]:
assumes "bf = [0, b, f]⇩∘" and "bf ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈"
shows "L_10_5_τ 𝔗 𝔎 c υ a⦇NTMap⦈⦇bf⦈ = υ⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇f⦈"
using assms unfolding L_10_5_τ_components by (simp add: nat_omega_simps)
subsubsection‹‹L_10_5_τ› is a cone›
lemma L_10_5_τ_is_cat_cone[cat_cs_intros]:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and υ'_def: "υ' = ntcf_arrow υ"
and υ: "υ :
Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∘⇩C⇩F 𝔎 ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
and a: "a ∈⇩∘ 𝔄⦇Obj⦈"
shows "L_10_5_τ 𝔗 𝔎 c υ' a : a <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
proof-
let ?H_ℭ = ‹λc. Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-)›
let ?H_𝔄 = ‹λa. Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-)›
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
from assms(3) interpret c𝔎: tiny_category α ‹c ↓⇩C⇩F 𝔎›
by (cs_concl cs_intro: cat_comma_cs_intros)
from assms(3) interpret Πc: is_tm_functor α ‹c ↓⇩C⇩F 𝔎› 𝔅 ‹c ⇩O⨅⇩C⇩F 𝔎›
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
)
interpret υ: is_ntcf α 𝔅 ‹cat_Set α› ‹?H_ℭ c ∘⇩C⇩F 𝔎› ‹?H_𝔄 a ∘⇩C⇩F 𝔗› υ
by (rule υ)
show ?thesis
proof(intro is_cat_coneI is_tm_ntcfI' is_ntcfI')
show "vfsequence (L_10_5_τ 𝔗 𝔎 c υ' a)" unfolding L_10_5_τ_def by simp
show "vcard (L_10_5_τ 𝔗 𝔎 c υ' a) = 5⇩ℕ"
unfolding L_10_5_τ_def by (simp add: nat_omega_simps)
from a interpret cf_const:
is_tm_functor α ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a›
by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
show "L_10_5_τ 𝔗 𝔎 c υ' a⦇NTMap⦈⦇bf⦈ :
cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a⦇ObjMap⦈⦇bf⦈ ↦⇘𝔄⇙ (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇bf⦈"
if "bf ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈" for bf
proof-
from that assms(3) obtain b f
where bf_def: "bf = [0, b, f]⇩∘"
and b: "b ∈⇩∘ 𝔅⦇Obj⦈"
and f: "f : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
by auto
from υ.ntcf_NTMap_is_arr[OF b] a b assms(3) f have "υ⦇NTMap⦈⦇b⦈ :
Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙ Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b⦈)"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
with that b f show "L_10_5_τ 𝔗 𝔎 c υ' a⦇NTMap⦈⦇bf⦈ :
cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a⦇ObjMap⦈⦇bf⦈ ↦⇘𝔄⇙ (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇bf⦈"
unfolding bf_def υ'_def
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_comma_cs_simps
cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed
show
"L_10_5_τ 𝔗 𝔎 c υ' a⦇NTMap⦈⦇B⦈ ∘⇩A⇘𝔄⇙ cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a⦇ArrMap⦈⦇F⦈ =
(𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ArrMap⦈⦇F⦈ ∘⇩A⇘𝔄⇙ L_10_5_τ 𝔗 𝔎 c υ' a⦇NTMap⦈⦇A⦈"
if "F : A ↦⇘c ↓⇩C⇩F 𝔎⇙ B" for A B F
proof-
from 𝔎.is_functor_axioms that assms(3) obtain a' f a'' f' g
where F_def: "F = [[0, a', f]⇩∘, [0, a'', f']⇩∘, [0, g]⇩∘]⇩∘"
and A_def: "A = [0, a', f]⇩∘"
and B_def: "B = [0, a'', f']⇩∘"
and g: "g : a' ↦⇘𝔅⇙ a''"
and f: "f : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇a'⦈"
and f': "f' : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇a''⦈"
and f'_def: "𝔎⦇ArrMap⦈⦇g⦈ ∘⇩A⇘ℭ⇙ f = f'"
by auto
from υ.ntcf_Comp_commute[OF g] have
"(υ⦇NTMap⦈⦇a''⦈ ∘⇩A⇘cat_Set α⇙ (?H_ℭ c ∘⇩C⇩F 𝔎)⦇ArrMap⦈⦇g⦈)⦇ArrVal⦈⦇f⦈ =
((?H_𝔄 a ∘⇩C⇩F 𝔗)⦇ArrMap⦈⦇g⦈ ∘⇩A⇘cat_Set α⇙ υ⦇NTMap⦈⦇a'⦈)⦇ArrVal⦈⦇f⦈"
by simp
from this a g f f' 𝔎.HomCod.category_axioms 𝔗.HomCod.category_axioms
have [cat_cs_simps]:
"υ⦇NTMap⦈⦇a''⦈⦇ArrVal⦈⦇𝔎⦇ArrMap⦈⦇g⦈ ∘⇩A⇘ℭ⇙ f⦈ =
𝔗⦇ArrMap⦈⦇g⦈ ∘⇩A⇘𝔄⇙ υ⦇NTMap⦈⦇a'⦈⦇ArrVal⦈⦇f⦈"
by
(
cs_prems
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros
)
from that a g f f' 𝔎.HomCod.category_axioms 𝔗.HomCod.category_axioms
show ?thesis
unfolding F_def A_def B_def υ'_def
by
(
cs_concl
cs_simp:
f'_def[symmetric]
cat_cs_simps
cat_Kan_cs_simps
cat_comma_cs_simps
cat_FUNCT_cs_simps
cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed
qed
(
use assms in
‹
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_Kan_cs_intros a
›
)+
qed
lemma L_10_5_τ_is_cat_cone'[cat_Kan_cs_intros]:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and "υ' = ntcf_arrow υ"
and "𝔉' = 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎"
and "c𝔎 = c ↓⇩C⇩F 𝔎"
and "𝔄' = 𝔄"
and "α' = α"
and "υ :
Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∘⇩C⇩F 𝔎 ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗 :
𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
and "a ∈⇩∘ 𝔄⦇Obj⦈"
shows "L_10_5_τ 𝔗 𝔎 c υ' a : a <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔉' : c𝔎 ↦↦⇩C⇘α'⇙ 𝔄'"
using assms(1-4,9,10) unfolding assms(5-8) by (rule L_10_5_τ_is_cat_cone)
subsection‹Lemma X.5: ‹L_10_5_υ››
subsubsection‹Definition and elementary properties›
definition L_10_5_υ :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "L_10_5_υ α 𝔗 𝔎 c τ a =
[
(λb∈⇩∘𝔗⦇HomDom⦈⦇Obj⦈. L_10_5_υ_arrow 𝔗 𝔎 c τ a b),
Hom⇩O⇩.⇩C⇘α⇙𝔎⦇HomCod⦈(c,-) ∘⇩C⇩F 𝔎,
Hom⇩O⇩.⇩C⇘α⇙𝔗⦇HomCod⦈(a,-) ∘⇩C⇩F 𝔗,
𝔗⦇HomDom⦈,
cat_Set α
]⇩∘"
text‹Components.›
lemma L_10_5_υ_components:
shows "L_10_5_υ α 𝔗 𝔎 c τ a⦇NTMap⦈ =
(λb∈⇩∘𝔗⦇HomDom⦈⦇Obj⦈. L_10_5_υ_arrow 𝔗 𝔎 c τ a b)"
and "L_10_5_υ α 𝔗 𝔎 c τ a⦇NTDom⦈ = Hom⇩O⇩.⇩C⇘α⇙𝔎⦇HomCod⦈(c,-) ∘⇩C⇩F 𝔎"
and "L_10_5_υ α 𝔗 𝔎 c τ a⦇NTCod⦈ = Hom⇩O⇩.⇩C⇘α⇙𝔗⦇HomCod⦈(a,-) ∘⇩C⇩F 𝔗"
and "L_10_5_υ α 𝔗 𝔎 c τ a⦇NTDGDom⦈ = 𝔗⦇HomDom⦈"
and "L_10_5_υ α 𝔗 𝔎 c τ a⦇NTDGCod⦈ = cat_Set α"
unfolding L_10_5_υ_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes α 𝔅 ℭ 𝔄 𝔎 𝔗
assumes 𝔎: "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)
lemmas L_10_5_υ_components' = L_10_5_υ_components[
where 𝔗=𝔗 and 𝔎=𝔎, unfolded cat_cs_simps
]
lemmas [cat_Kan_cs_simps] = L_10_5_υ_components'(2-5)
end
subsubsection‹Natural transformation map›
mk_VLambda L_10_5_υ_components(1)
|vsv L_10_5_υ_NTMap_vsv[cat_Kan_cs_intros]|
context
fixes α 𝔅 ℭ 𝔄 𝔎 𝔗
assumes 𝔎: "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
interpretation 𝔎: is_functor α 𝔅 ℭ 𝔎 by (rule 𝔎)
interpretation 𝔗: is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)
mk_VLambda L_10_5_υ_components'(1)[OF 𝔎 𝔗]
|vdomain L_10_5_υ_NTMap_vdomain[cat_Kan_cs_simps]|
|app L_10_5_υ_NTMap_app[cat_Kan_cs_simps]|
end
subsubsection‹‹L_10_5_υ› is a natural transformation›
lemma L_10_5_υ_is_ntcf:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and τ'_def: "τ' = ntcf_arrow τ"
and τ: "τ : a <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and a: "a ∈⇩∘ 𝔄⦇Obj⦈"
shows "L_10_5_υ α 𝔗 𝔎 c τ' a :
Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∘⇩C⇩F 𝔎 ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
(is ‹?L_10_5_υ : ?H_ℭ c ∘⇩C⇩F 𝔎 ↦⇩C⇩F ?H_𝔄 a ∘⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ cat_Set α›)
proof-
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
interpret τ: is_cat_cone α a ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› τ
by (rule assms(5))
from assms(3) interpret c𝔎: tiny_category α ‹c ↓⇩C⇩F 𝔎›
by (cs_concl cs_intro: cat_comma_cs_intros)
from assms(3) interpret Πc: is_tm_functor α ‹c ↓⇩C⇩F 𝔎› 𝔅 ‹c ⇩O⨅⇩C⇩F 𝔎›
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
)
show "?L_10_5_υ : ?H_ℭ c ∘⇩C⇩F 𝔎 ↦⇩C⇩F ?H_𝔄 a ∘⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
proof(intro is_ntcfI')
show "vfsequence ?L_10_5_υ" unfolding L_10_5_υ_def by auto
show "vcard ?L_10_5_υ = 5⇩ℕ"
unfolding L_10_5_υ_def by (simp add: nat_omega_simps)
show "?L_10_5_υ⦇NTMap⦈⦇b⦈ :
(?H_ℭ c ∘⇩C⇩F 𝔎)⦇ObjMap⦈⦇b⦈ ↦⇘cat_Set α⇙ (?H_𝔄 a ∘⇩C⇩F 𝔗)⦇ObjMap⦈⦇b⦈"
if "b ∈⇩∘ 𝔅⦇Obj⦈" for b
proof-
from a that assms(3) show ?thesis
unfolding τ'_def
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro:
cat_Kan_cs_intros
cat_lim_cs_intros
cat_cs_intros
cat_op_intros
)
qed
show
"?L_10_5_υ⦇NTMap⦈⦇b'⦈ ∘⇩A⇘cat_Set α⇙ (?H_ℭ c ∘⇩C⇩F 𝔎)⦇ArrMap⦈⦇f⦈ =
(?H_𝔄 a ∘⇩C⇩F 𝔗)⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ ?L_10_5_υ⦇NTMap⦈⦇a'⦈"
if "f : a' ↦⇘𝔅⇙ b'" for a' b' f
proof-
from that a assms(3) show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps τ'_def
cs_intro: cat_lim_cs_intros cat_cs_intros
)
qed
qed
(
use assms(3,6) in
‹
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
›
)+
qed
lemma L_10_5_υ_is_ntcf'[cat_Kan_cs_intros]:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and "τ' = ntcf_arrow τ"
and "𝔉' = Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∘⇩C⇩F 𝔎"
and "𝔊' = Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗"
and "𝔅' = 𝔅"
and "ℭ' = cat_Set α"
and "α' = α"
and "τ : a <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and "a ∈⇩∘ 𝔄⦇Obj⦈"
shows "L_10_5_υ α 𝔗 𝔎 c τ' a : 𝔉' ↦⇩C⇩F 𝔊' : 𝔅' ↦↦⇩C⇘α'⇙ ℭ'"
using assms(1-4,10,11) unfolding assms(5-9) by (rule L_10_5_υ_is_ntcf)
subsection‹Lemma X.5: ‹L_10_5_χ_arrow››
subsubsection‹Definition and elementary properties›
definition L_10_5_χ_arrow
where "L_10_5_χ_arrow α β 𝔗 𝔎 c a =
[
(λυ∈⇩∘L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈. ntcf_arrow (L_10_5_τ 𝔗 𝔎 c υ a)),
L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈,
cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈
]⇩∘"
text‹Components.›
lemma L_10_5_χ_arrow_components:
shows "L_10_5_χ_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈ =
(λυ∈⇩∘L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈. ntcf_arrow (L_10_5_τ 𝔗 𝔎 c υ a))"
and "L_10_5_χ_arrow α β 𝔗 𝔎 c a⦇ArrDom⦈ = L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
and "L_10_5_χ_arrow α β 𝔗 𝔎 c a⦇ArrCod⦈ =
cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈"
unfolding L_10_5_χ_arrow_def arr_field_simps
by (simp_all add: nat_omega_simps)
lemmas [cat_Kan_cs_simps] = L_10_5_χ_arrow_components(2,3)
subsubsection‹Arrow value›
mk_VLambda L_10_5_χ_arrow_components(1)
|vsv L_10_5_χ_arrow_vsv[cat_Kan_cs_intros]|
|vdomain L_10_5_χ_arrow_vdomain|
|app L_10_5_χ_arrow_app|
lemma L_10_5_χ_arrow_vdomain'[cat_Kan_cs_simps]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and "a ∈⇩∘ 𝔄⦇Obj⦈"
shows "𝒟⇩∘ (L_10_5_χ_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈) = Hom
(cat_FUNCT α 𝔅 (cat_Set α))
(cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∘⇩C⇩F 𝔎))
(cf_map (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗))"
using assms
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps L_10_5_χ_arrow_vdomain
cs_intro: cat_cs_intros
)
lemma L_10_5_χ_arrow_app'[cat_Kan_cs_simps]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔎 : 𝔅 ↦↦⇩C⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and υ'_def: "υ' = ntcf_arrow υ"
and υ: "υ :
Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∘⇩C⇩F 𝔎 ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
and a: "a ∈⇩∘ 𝔄⦇Obj⦈"
shows
"L_10_5_χ_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈⦇υ'⦈ =
ntcf_arrow (L_10_5_τ 𝔗 𝔎 c υ' a)"
using assms
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps L_10_5_χ_arrow_app
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
lemma υτa_def:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and υτa'_def: "υτa' = ntcf_arrow υτa"
and υτa: "υτa :
Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∘⇩C⇩F 𝔎 ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗 :
𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
and a: "a ∈⇩∘ 𝔄⦇Obj⦈"
shows "υτa = L_10_5_υ α 𝔗 𝔎 c (ntcf_arrow (L_10_5_τ 𝔗 𝔎 c υτa' a)) a"
(is ‹υτa = ?L_10_5_υ (ntcf_arrow ?L_10_5_τ) a›)
proof-
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
interpret υτa: is_ntcf
α 𝔅 ‹cat_Set α› ‹Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∘⇩C⇩F 𝔎› ‹Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗› υτa
by (rule υτa)
show ?thesis
proof(rule ntcf_eqI)
show "υτa :
Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∘⇩C⇩F 𝔎 ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by (rule υτa)
from assms(1-3) a show
"?L_10_5_υ (ntcf_arrow ?L_10_5_τ) a :
Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∘⇩C⇩F 𝔎 ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps υτa'_def
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
have dom_lhs: "𝒟⇩∘ (υτa⦇NTMap⦈) = 𝔅⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
have dom_rhs: "𝒟⇩∘ (?L_10_5_υ (ntcf_arrow (?L_10_5_τ)) a⦇NTMap⦈) = 𝔅⦇Obj⦈"
by (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)
show "υτa⦇NTMap⦈ = ?L_10_5_υ (ntcf_arrow ?L_10_5_τ) a⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix b assume prems: "b ∈⇩∘ 𝔅⦇Obj⦈"
from prems assms(3) a have lhs: "υτa⦇NTMap⦈⦇b⦈ :
Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙ Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
then have dom_lhs: "𝒟⇩∘ (υτa⦇NTMap⦈⦇b⦈⦇ArrVal⦈) = Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈)"
by (cs_concl cs_simp: cat_cs_simps)
from prems assms(3) a have rhs:
"L_10_5_υ_arrow 𝔗 𝔎 c (ntcf_arrow ?L_10_5_τ) a b :
Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙ Hom 𝔄 a (𝔗⦇ObjMap⦈⦇b⦈)"
unfolding υτa'_def
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_small_cs_intros cat_Kan_cs_intros cat_cs_intros
)
then have dom_rhs:
"𝒟⇩∘ (L_10_5_υ_arrow 𝔗 𝔎 c (ntcf_arrow ?L_10_5_τ) a b⦇ArrVal⦈) =
Hom ℭ c (𝔎⦇ObjMap⦈⦇b⦈)"
by (cs_concl cs_simp: cat_cs_simps)
have [cat_cs_simps]:
"υτa⦇NTMap⦈⦇b⦈ = L_10_5_υ_arrow 𝔗 𝔎 c (ntcf_arrow ?L_10_5_τ) a b"
proof(rule arr_Set_eqI)
from lhs show arr_Set_lhs: "arr_Set α (υτa⦇NTMap⦈⦇b⦈)"
by (auto dest: cat_Set_is_arrD(1))
from rhs show arr_Set_rhs:
"arr_Set α (L_10_5_υ_arrow 𝔗 𝔎 c (ntcf_arrow (?L_10_5_τ)) a b)"
by (auto dest: cat_Set_is_arrD(1))
show "υτa⦇NTMap⦈⦇b⦈⦇ArrVal⦈ =
L_10_5_υ_arrow 𝔗 𝔎 c (ntcf_arrow ?L_10_5_τ) a b⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix f assume "f : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
with assms prems show
"υτa⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇f⦈ =
L_10_5_υ_arrow 𝔗 𝔎 c (ntcf_arrow ?L_10_5_τ) a b⦇ArrVal⦈⦇f⦈"
unfolding υτa'_def
by
(
cs_concl
cs_simp:
cat_Kan_cs_simps cat_FUNCT_cs_simps L_10_5_υ_arrow_ArrVal_app
cs_intro: cat_cs_intros cat_comma_cs_intros
)
qed (use arr_Set_lhs arr_Set_rhs in auto)
qed (use lhs rhs in ‹cs_concl cs_simp: cat_cs_simps›)+
from prems show
"υτa⦇NTMap⦈⦇b⦈ = L_10_5_υ α 𝔗 𝔎 c (ntcf_arrow ?L_10_5_τ) a⦇NTMap⦈⦇b⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros cat_Kan_cs_intros V_cs_intros)+
qed simp_all
qed
subsection‹Lemma X.5: ‹L_10_5_χ'_arrow››
subsubsection‹Definition and elementary properties›
definition L_10_5_χ'_arrow :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "L_10_5_χ'_arrow α β 𝔗 𝔎 c a =
[
(
λτ∈⇩∘cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈.
ntcf_arrow (L_10_5_υ α 𝔗 𝔎 c τ a)
),
cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈,
L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈
]⇩∘"
text‹Components.›
lemma L_10_5_χ'_arrow_components:
shows "L_10_5_χ'_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈ =
(
λτ∈⇩∘cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈.
ntcf_arrow (L_10_5_υ α 𝔗 𝔎 c τ a)
)"
and [cat_Kan_cs_simps]: "L_10_5_χ'_arrow α β 𝔗 𝔎 c a⦇ArrDom⦈ =
cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈"
and [cat_Kan_cs_simps]: "L_10_5_χ'_arrow α β 𝔗 𝔎 c a⦇ArrCod⦈ =
L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
unfolding L_10_5_χ'_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)
subsubsection‹Arrow value›
mk_VLambda L_10_5_χ'_arrow_components(1)
|vsv L_10_5_χ'_arrow_ArrVal_vsv[cat_Kan_cs_intros]|
|vdomain L_10_5_χ'_arrow_ArrVal_vdomain|
|app L_10_5_χ'_arrow_ArrVal_app|
lemma L_10_5_χ'_arrow_ArrVal_vdomain'[cat_Kan_cs_simps]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and τ: "τ : a <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and a: "a ∈⇩∘ 𝔄⦇Obj⦈"
shows "𝒟⇩∘ (L_10_5_χ'_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈) = Hom
(cat_Funct α (c ↓⇩C⇩F 𝔎) 𝔄)
(cf_map (cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a))
(cf_map (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎))"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret τ: is_cat_cone α a ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› τ
by (rule assms(3))
from assms(2,4) show ?thesis
by
(
cs_concl
cs_simp: cat_Kan_cs_simps L_10_5_χ'_arrow_ArrVal_vdomain
cs_intro: cat_cs_intros
)
qed
lemma L_10_5_χ'_arrow_ArrVal_app'[cat_cs_simps]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and τ'_def: "τ' = ntcf_arrow τ"
and τ: "τ : a <⇩C⇩F⇩.⇩c⇩o⇩n⇩e 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
and a: "a ∈⇩∘ 𝔄⦇Obj⦈"
shows "L_10_5_χ'_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈⦇τ'⦈ =
ntcf_arrow (L_10_5_υ α 𝔗 𝔎 c τ' a)"
proof-
interpret β: 𝒵 β by (rule assms(1))
interpret τ: is_cat_cone α a ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› τ
by (rule assms(4))
from assms(2,5) have "τ' ∈⇩∘ cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈"
unfolding τ'_def
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_Funct_components(1)
cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros cat_cs_intros
)
then show
"L_10_5_χ'_arrow α β 𝔗 𝔎 c a⦇ArrVal⦈⦇τ'⦈ =
ntcf_arrow (L_10_5_υ α 𝔗 𝔎 c τ' a)"
unfolding L_10_5_χ'_arrow_components by auto
qed
subsubsection‹‹L_10_5_χ'_arrow› is an isomorphism in the category ‹Set››
lemma L_10_5_χ'_arrow_is_arr_isomorphism:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and "a ∈⇩∘ 𝔄⦇Obj⦈"
shows "L_10_5_χ'_arrow α β 𝔗 𝔎 c a :
cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈ ↦⇩i⇩s⇩o⇘cat_Set β⇙
L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
(
is
‹
?L_10_5_χ'_arrow :
cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈ ↦⇩i⇩s⇩o⇘cat_Set β⇙
?L_10_5_N⦇ObjMap⦈⦇a⦈
›
)
proof-
let ?FUNCT = ‹λ𝔄. cat_FUNCT α 𝔄 (cat_Set α)›
let ?c𝔎_𝔄 = ‹cat_Funct α (c ↓⇩C⇩F 𝔎) 𝔄›
let ?H_ℭ = ‹λc. Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-)›
let ?H_𝔄 = ‹λc. Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-)›
from assms(1,2) interpret β: 𝒵 β by simp
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(3))
interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(4))
from 𝔎.vempty_is_zet assms interpret c𝔎: tiny_category α ‹c ↓⇩C⇩F 𝔎›
by (cs_concl cs_intro: cat_comma_cs_intros)
from assms(2,6) interpret c𝔎_𝔄: category α ?c𝔎_𝔄
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from 𝔎.vempty_is_zet assms interpret Πc:
is_tm_functor α ‹c ↓⇩C⇩F 𝔎› 𝔅 ‹c ⇩O⨅⇩C⇩F 𝔎›
by (cs_concl cs_intro: cat_comma_cs_intros)
from assms(2) interpret FUNCT_𝔄: tiny_category β ‹?FUNCT 𝔄›
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms(2) interpret FUNCT_𝔅: tiny_category β ‹?FUNCT 𝔅›
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms(2) interpret FUNCT_ℭ: tiny_category β ‹?FUNCT ℭ›
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
have 𝔗Π: "𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
by (cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)
from assms(5,6) have [cat_cs_simps]:
"cf_of_cf_map (c ↓⇩C⇩F 𝔎) 𝔄 (cf_map (cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a)) =
cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a"
"cf_of_cf_map (c ↓⇩C⇩F 𝔎) 𝔄 (cf_map (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)) = 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎"
"cf_of_cf_map 𝔅 (cat_Set α) (cf_map (Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∘⇩C⇩F 𝔎)) =
Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-) ∘⇩C⇩F 𝔎"
"cf_of_cf_map 𝔅 (cat_Set α) (cf_map (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗)) =
Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)+
note cf_Cone_ObjMap_app = is_tm_functor.cf_Cone_ObjMap_app[OF 𝔗Π assms(1,2,6)]
show ?thesis
proof
(
intro cat_Set_is_arr_isomorphismI cat_Set_is_arrI arr_SetI,
unfold L_10_5_χ'_arrow_components(3) cf_Cone_ObjMap_app
)
show "vfsequence ?L_10_5_χ'_arrow"
unfolding L_10_5_χ'_arrow_def by auto
show χ'_arrow_ArrVal_vsv: "vsv (?L_10_5_χ'_arrow⦇ArrVal⦈)"
unfolding L_10_5_χ'_arrow_components by auto
show "vcard ?L_10_5_χ'_arrow = 3⇩ℕ"
unfolding L_10_5_χ'_arrow_def by (simp add: nat_omega_simps)
show [cat_cs_simps]:
"𝒟⇩∘ (?L_10_5_χ'_arrow⦇ArrVal⦈) = ?L_10_5_χ'_arrow⦇ArrDom⦈"
unfolding L_10_5_χ'_arrow_components by simp
show vrange_χ'_arrow_vsubset_N'':
"ℛ⇩∘ (?L_10_5_χ'_arrow⦇ArrVal⦈) ⊆⇩∘ ?L_10_5_N⦇ObjMap⦈⦇a⦈"
unfolding L_10_5_χ'_arrow_components
proof(rule vrange_VLambda_vsubset)
fix τ assume prems: "τ ∈⇩∘ cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈"
from this assms c𝔎_𝔄.category_axioms have τ_is_arr:
"τ : cf_map (cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a) ↦⇘?c𝔎_𝔄⇙ cf_map (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)"
by
(
cs_prems
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_Funct_components(1)
cs_intro: cat_small_cs_intros
)
note τ = cat_Funct_is_arrD(1,2)[OF τ_is_arr, unfolded cat_cs_simps]
have "cf_of_cf_map (c ↓⇩C⇩F 𝔎) 𝔄 (cf_map (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)) = 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
from prems assms τ(1) show
"ntcf_arrow (L_10_5_υ α 𝔗 𝔎 c τ a) ∈⇩∘ ?L_10_5_N⦇ObjMap⦈⦇a⦈"
by (subst τ(2))
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro:
is_cat_coneI cat_cs_intros cat_Kan_cs_intros cat_FUNCT_cs_intros
)
qed
show "ℛ⇩∘ (?L_10_5_χ'_arrow⦇ArrVal⦈) = ?L_10_5_N⦇ObjMap⦈⦇a⦈"
proof
(
intro vsubset_antisym[OF vrange_χ'_arrow_vsubset_N''],
intro vsubsetI
)
fix υτa assume "υτa ∈⇩∘ ?L_10_5_N⦇ObjMap⦈⦇a⦈"
from this assms have υτa:
"υτa : cf_map (?H_ℭ c ∘⇩C⇩F 𝔎) ↦⇘?FUNCT 𝔅⇙ cf_map (?H_𝔄 a ∘⇩C⇩F 𝔗)"
by
(
cs_prems
cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
)
note υτa = cat_FUNCT_is_arrD[OF this, unfolded cat_cs_simps]
interpret τ:
is_cat_cone α a ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› ‹L_10_5_τ 𝔗 𝔎 c υτa a›
by (rule L_10_5_τ_is_cat_cone[OF assms(3,4,5) υτa(2,1) assms(6)])
show "υτa ∈⇩∘ ℛ⇩∘ (?L_10_5_χ'_arrow⦇ArrVal⦈)"
proof(rule vsv.vsv_vimageI2')
show "vsv (?L_10_5_χ'_arrow⦇ArrVal⦈)" by (rule χ'_arrow_ArrVal_vsv)
from τ.is_cat_cone_axioms assms show
"ntcf_arrow (L_10_5_τ 𝔗 𝔎 c υτa a) ∈⇩∘ 𝒟⇩∘ (?L_10_5_χ'_arrow⦇ArrVal⦈)"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
from assms υτa(1,2) show
"υτa = ?L_10_5_χ'_arrow⦇ArrVal⦈⦇ntcf_arrow (L_10_5_τ 𝔗 𝔎 c υτa a)⦈"
by
(
subst υτa(2),
cs_concl_step υτa_def[OF assms(3,4,5) υτa(2,1) assms(6)]
)
(cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed
qed
from assms show "?L_10_5_χ'_arrow⦇ArrDom⦈ ∈⇩∘ Vset β"
by (intro Vset_trans[OF _ Vset_in_mono[OF assms(2)]])
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_Funct_components(1) cf_Cone_ObjMap_app
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
c𝔎_𝔄.cat_Hom_in_Vset
)
with assms(2) have "?L_10_5_χ'_arrow⦇ArrDom⦈ ∈⇩∘ Vset β"
by (meson Vset_in_mono Vset_trans)
from assms show "?L_10_5_N⦇ObjMap⦈⦇a⦈ ∈⇩∘ Vset β"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros FUNCT_𝔅.cat_Hom_in_Vset cat_FUNCT_cs_intros
)
show dom_χ'_arrow: "𝒟⇩∘ (?L_10_5_χ'_arrow⦇ArrVal⦈) =
Hom ?c𝔎_𝔄 (cf_map (cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a)) (cf_map (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎))"
unfolding L_10_5_χ'_arrow_components cf_Cone_ObjMap_app by simp
show "?L_10_5_χ'_arrow⦇ArrDom⦈ =
Hom ?c𝔎_𝔄 (cf_map (cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a)) (cf_map (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎))"
unfolding L_10_5_χ'_arrow_components cf_Cone_ObjMap_app by simp
show "v11 (?L_10_5_χ'_arrow⦇ArrVal⦈)"
proof(rule vsv.vsv_valeq_v11I, unfold dom_χ'_arrow in_Hom_iff)
fix τ' τ'' assume prems:
"τ' : cf_map (cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a) ↦⇘?c𝔎_𝔄⇙ cf_map (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)"
"τ'' : cf_map (cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a) ↦⇘?c𝔎_𝔄⇙ cf_map (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)"
"?L_10_5_χ'_arrow⦇ArrVal⦈⦇τ'⦈ = ?L_10_5_χ'_arrow⦇ArrVal⦈⦇τ''⦈"
note τ' = cat_Funct_is_arrD[OF prems(1), unfolded cat_cs_simps]
and τ'' = cat_Funct_is_arrD[OF prems(2), unfolded cat_cs_simps]
interpret τ': is_cat_cone
α a ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› ‹ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ'›
by (rule is_cat_coneI[OF τ'(1) assms(6)])
interpret τ'': is_cat_cone
α a ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› ‹ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ''›
by (rule is_cat_coneI[OF τ''(1) assms(6)])
have τ'τ': "ntcf_arrow (ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ') = τ'"
by (subst (2) τ'(2)) (cs_concl cs_simp: cat_FUNCT_cs_simps)
have τ''τ'': "ntcf_arrow (ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ'') = τ''"
by (subst (2) τ''(2)) (cs_concl cs_simp: cat_FUNCT_cs_simps)
from prems(3) τ'(1) τ''(1) assms have
"L_10_5_υ α 𝔗 𝔎 c τ' a = L_10_5_υ α 𝔗 𝔎 c τ'' a"
by (subst (asm) τ'(2), use nothing in ‹subst (asm) τ''(2)›)
(
cs_prems
cs_simp: τ'τ' τ''τ'' cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_lim_cs_intros cat_Kan_cs_intros cat_cs_intros
)
from this have υτ'a_υτ''a:
"L_10_5_υ α 𝔗 𝔎 c τ' a⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇f⦈ =
L_10_5_υ α 𝔗 𝔎 c τ'' a⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇f⦈"
if "b ∈⇩∘ 𝔅⦇Obj⦈" and "f : c ↦⇘ℭ⇙ (𝔎⦇ObjMap⦈⦇b⦈)" for b f
by simp
have [cat_cs_simps]: "τ'⦇NTMap⦈⦇0, b, f⦈⇩∙ = τ''⦇NTMap⦈⦇0, b, f⦈⇩∙"
if "b ∈⇩∘ 𝔅⦇Obj⦈" and "f : c ↦⇘ℭ⇙ (𝔎⦇ObjMap⦈⦇b⦈)" for b f
using υτ'a_υτ''a[OF that] that
by
(
cs_prems
cs_simp: cat_Kan_cs_simps L_10_5_υ_arrow_ArrVal_app
cs_intro: cat_cs_intros
)
have
"ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ' =
ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ''"
proof(rule ntcf_eqI)
show "ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ' :
cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a ↦⇩C⇩F 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by (rule τ'.is_ntcf_axioms)
then have dom_lhs:
"𝒟⇩∘ (ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ'⦇NTMap⦈) = c ↓⇩C⇩F 𝔎⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
show "ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ'' :
cf_const (c ↓⇩C⇩F 𝔎) 𝔄 a ↦⇩C⇩F 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by (rule τ''.is_ntcf_axioms)
then have dom_rhs:
"𝒟⇩∘ (ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ''⦇NTMap⦈) = c ↓⇩C⇩F 𝔎⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
show
"ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ'⦇NTMap⦈ =
ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ''⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix A assume "A ∈⇩∘ c ↓⇩C⇩F 𝔎⦇Obj⦈"
with assms(5) obtain b f
where A_def: "A = [0, b, f]⇩∘"
and b: "b ∈⇩∘ 𝔅⦇Obj⦈"
and f: "f : c ↦⇘ℭ⇙ 𝔎⦇ObjMap⦈⦇b⦈"
by auto
from b f show
"ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ'⦇NTMap⦈⦇A⦈ =
ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 τ''⦇NTMap⦈⦇A⦈"
unfolding A_def
by (cs_concl cs_simp: cat_cs_simps cat_FUNCT_cs_simps)
qed (cs_concl cs_intro: V_cs_intros)+
qed simp_all
then show "τ' = τ''"
proof(rule inj_onD[OF bij_betw_imp_inj_on[OF bij_betw_ntcf_of_ntcf_arrow]])
show "τ' ∈⇩∘ ntcf_arrows α (c ↓⇩C⇩F 𝔎) 𝔄"
by (subst τ'(2))
(
cs_concl cs_intro:
cat_lim_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
show "τ'' ∈⇩∘ ntcf_arrows α (c ↓⇩C⇩F 𝔎) 𝔄"
by (subst τ''(2))
(
cs_concl cs_intro:
cat_lim_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed
qed (cs_concl cs_intro: cat_Kan_cs_intros)
qed auto
qed
lemma L_10_5_χ'_arrow_is_arr_isomorphism'[cat_Kan_cs_intros]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and "a ∈⇩∘ 𝔄⦇Obj⦈"
and "A = cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈"
and "B = L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
and "ℭ' = cat_Set β"
shows "L_10_5_χ'_arrow α β 𝔗 𝔎 c a : A ↦⇩i⇩s⇩o⇘ℭ'⇙ B"
using assms(1-6)
unfolding assms(7-9)
by (rule L_10_5_χ'_arrow_is_arr_isomorphism)
lemma L_10_5_χ'_arrow_is_arr:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and "a ∈⇩∘ 𝔄⦇Obj⦈"
shows "L_10_5_χ'_arrow α β 𝔗 𝔎 c a :
cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set β⇙
L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
by
(
rule cat_Set_is_arr_isomorphismD(1)[
OF L_10_5_χ'_arrow_is_arr_isomorphism[OF assms(1-6)]
]
)
lemma L_10_5_χ'_arrow_is_arr'[cat_Kan_cs_intros]:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
and "a ∈⇩∘ 𝔄⦇Obj⦈"
and "A = cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)⦇ObjMap⦈⦇a⦈"
and "B = L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
and "ℭ' = cat_Set β"
shows "L_10_5_χ'_arrow α β 𝔗 𝔎 c a : A ↦⇘ℭ'⇙ B"
using assms(1-6) unfolding assms(7-9) by (rule L_10_5_χ'_arrow_is_arr)
subsection‹Lemma X.5: ‹L_10_5_χ›\label{sec:lem_X_5_end}›
subsubsection‹Definition and elementary properties›
definition L_10_5_χ :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "L_10_5_χ α β 𝔗 𝔎 c =
[
(λa∈⇩∘𝔗⦇HomCod⦈⦇Obj⦈. L_10_5_χ'_arrow α β 𝔗 𝔎 c a),
cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎),
L_10_5_N α β 𝔗 𝔎 c,
op_cat (𝔗⦇HomCod⦈),
cat_Set β
]⇩∘"
text‹Components.›
lemma L_10_5_χ_components:
shows "L_10_5_χ α β 𝔗 𝔎 c⦇NTMap⦈ =
(λa∈⇩∘𝔗⦇HomCod⦈⦇Obj⦈. L_10_5_χ'_arrow α β 𝔗 𝔎 c a)"
and [cat_Kan_cs_simps]:
"L_10_5_χ α β 𝔗 𝔎 c⦇NTDom⦈ = cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎)"
and [cat_Kan_cs_simps]:
"L_10_5_χ α β 𝔗 𝔎 c⦇NTCod⦈ = L_10_5_N α β 𝔗 𝔎 c"
and "L_10_5_χ α β 𝔗 𝔎 c⦇NTDGDom⦈ = op_cat (𝔗⦇HomCod⦈)"
and [cat_Kan_cs_simps]: "L_10_5_χ α β 𝔗 𝔎 c⦇NTDGCod⦈ = cat_Set β"
unfolding L_10_5_χ_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes α 𝔄 𝔅 𝔗
assumes 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
interpretation is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)
lemmas L_10_5_χ_components' =
L_10_5_χ_components[where 𝔗=𝔗, unfolded cat_cs_simps]
lemmas [cat_Kan_cs_simps] = L_10_5_χ_components'(4)
end
subsubsection‹Natural transformation map›
mk_VLambda L_10_5_χ_components(1)
|vsv L_10_5_χ_NTMap_vsv[cat_Kan_cs_intros]|
context
fixes α 𝔄 𝔅 𝔗
assumes 𝔗: "𝔗 : 𝔅 ↦↦⇩C⇘α⇙ 𝔄"
begin
interpretation is_functor α 𝔅 𝔄 𝔗 by (rule 𝔗)
mk_VLambda L_10_5_χ_components(1)[where 𝔗=𝔗, unfolded cat_cs_simps]
|vdomain L_10_5_χ_NTMap_vdomain[cat_Kan_cs_simps]|
|app L_10_5_χ_NTMap_app[cat_Kan_cs_simps]|
end
subsubsection‹‹L_10_5_χ› is a natural isomorphism›
lemma L_10_5_χ_is_iso_ntcf:
assumes "𝒵 β"
and "α ∈⇩∘ β"
and "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
shows "L_10_5_χ α β 𝔗 𝔎 c :
cf_Cone α β (𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎) ↦⇩C⇩F⇩.⇩i⇩s⇩o L_10_5_N α β 𝔗 𝔎 c :
op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
(is ‹?L_10_5_χ : ?cf_Cone ↦⇩C⇩F⇩.⇩i⇩s⇩o ?L_10_5_N : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β›)
proof-
let ?FUNCT = ‹λ𝔄. cat_FUNCT α 𝔄 (cat_Set α)›
let ?c𝔎_𝔄 = ‹cat_Funct α (c ↓⇩C⇩F 𝔎) 𝔄›
let ?ntcf_c𝔎_𝔄 = ‹ntcf_const (c ↓⇩C⇩F 𝔎) 𝔄›
let ?𝔗_c𝔎 = ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎›
let ?H_ℭ = ‹λc. Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-)›
let ?H_𝔄 = ‹λa. Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-)›
let ?L_10_5_χ'_arrow = ‹L_10_5_χ'_arrow α β 𝔗 𝔎 c›
let ?cf_c𝔎_𝔄 = ‹cf_const (c ↓⇩C⇩F 𝔎) 𝔄›
let ?L_10_5_υ = ‹L_10_5_υ α 𝔗 𝔎 c›
let ?L_10_5_υ_arrow = ‹L_10_5_υ_arrow 𝔗 𝔎 c›
interpret β: 𝒵 β by (rule assms(1))
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(3))
interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(4))
from 𝔎.vempty_is_zet assms(5) interpret c𝔎: tiny_category α ‹c ↓⇩C⇩F 𝔎›
by (cs_concl cs_intro: cat_comma_cs_intros)
from assms(2,5) interpret c𝔎_𝔄: category α ?c𝔎_𝔄
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
interpret β_c𝔎_𝔄: category β ?c𝔎_𝔄
by (rule c𝔎_𝔄.cat_category_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros assms(2))+
from assms(2,5) interpret Δ: is_functor α 𝔄 ?c𝔎_𝔄 ‹Δ⇩C α (c ↓⇩C⇩F 𝔎) 𝔄›
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Δ.is_functor_axioms assms(2) interpret βΔ:
is_functor β 𝔄 ?c𝔎_𝔄 ‹Δ⇩C α (c ↓⇩C⇩F 𝔎) 𝔄›
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from 𝔎.vempty_is_zet assms(5) interpret Πc:
is_tm_functor α ‹c ↓⇩C⇩F 𝔎› 𝔅 ‹c ⇩O⨅⇩C⇩F 𝔎›
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
)
interpret βΠc: is_tiny_functor β ‹c ↓⇩C⇩F 𝔎› 𝔅 ‹c ⇩O⨅⇩C⇩F 𝔎›
by (rule Πc.cf_is_tiny_functor_if_ge_Limit[OF assms(1,2)])
interpret E: is_functor β ‹?FUNCT ℭ ×⇩C ℭ› ‹cat_Set β› ‹cf_eval α β ℭ›
by (rule 𝔎.HomCod.cat_cf_eval_is_functor[OF assms(1,2)])
from assms(2) interpret FUNCT_𝔄: tiny_category β ‹?FUNCT 𝔄›
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms(2) interpret FUNCT_𝔅: tiny_category β ‹?FUNCT 𝔅›
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from assms(2) interpret FUNCT_ℭ: tiny_category β ‹?FUNCT ℭ›
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
interpret β𝔄: tiny_category β 𝔄
by (rule category.cat_tiny_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
interpret β𝔅: tiny_category β 𝔅
by (rule category.cat_tiny_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
interpret βℭ: tiny_category β ℭ
by (rule category.cat_tiny_category_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
interpret β𝔎: is_tiny_functor β 𝔅 ℭ 𝔎
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
interpret β𝔗: is_tiny_functor β 𝔅 𝔄 𝔗
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use assms(2) in ‹cs_concl cs_simp: cs_intro: cat_cs_intros›)+
interpret cat_Set_αβ: subcategory β ‹cat_Set α› ‹cat_Set β›
by (rule 𝔎.subcategory_cat_Set_cat_Set[OF assms(1,2)])
show ?thesis
proof(intro is_iso_ntcfI is_ntcfI', unfold cat_op_simps)
show "vfsequence (?L_10_5_χ)" unfolding L_10_5_χ_def by auto
show "vcard (?L_10_5_χ) = 5⇩ℕ"
unfolding L_10_5_χ_def by (simp add: nat_omega_simps)
from assms(2) show "?cf_Cone : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
by (intro is_tm_functor.tm_cf_cf_Cone_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_small_cs_intros cat_cs_intros)+
from assms show "?L_10_5_N : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
by (cs_concl cs_intro: cat_Kan_cs_intros)
show "?L_10_5_χ⦇NTMap⦈⦇a⦈ :
?cf_Cone⦇ObjMap⦈⦇a⦈ ↦⇩i⇩s⇩o⇘cat_Set β⇙ ?L_10_5_N⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ 𝔄⦇Obj⦈" for a
using assms(2,3,4,5) that
by
(
cs_concl
cs_simp: L_10_5_χ_NTMap_app
cs_intro: cat_cs_intros L_10_5_χ'_arrow_is_arr_isomorphism
)
from cat_Set_is_arr_isomorphismD[OF this] show
"?L_10_5_χ⦇NTMap⦈⦇a⦈ : ?cf_Cone⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set β⇙ ?L_10_5_N⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ 𝔄⦇Obj⦈" for a
using that by auto
have [cat_cs_simps]:
"?L_10_5_χ'_arrow b ∘⇩A⇘cat_Set β⇙
cf_hom ?c𝔎_𝔄 [ntcf_arrow (?ntcf_c𝔎_𝔄 f), ntcf_arrow (ntcf_id ?𝔗_c𝔎)]⇩∘ =
cf_hom (?FUNCT 𝔅)
[
ntcf_arrow (ntcf_id (?H_ℭ c ∘⇩C⇩F 𝔎)),
ntcf_arrow (Hom⇩A⇩.⇩C⇘α⇙𝔄(f,-) ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔗)
]⇩∘ ∘⇩A⇘cat_Set β⇙ ?L_10_5_χ'_arrow a"
(
is
"?L_10_5_χ'_arrow b ∘⇩A⇘cat_Set β⇙ ?cf_hom_lhs =
?cf_hom_rhs ∘⇩A⇘cat_Set β⇙ ?L_10_5_χ'_arrow a"
)
if "f : b ↦⇘𝔄⇙ a" for a b f
proof-
let ?H_f = ‹Hom⇩A⇩.⇩C⇘α⇙𝔄(f,-)›
from that assms β_c𝔎_𝔄.category_axioms c𝔎_𝔄.category_axioms have lhs:
"?L_10_5_χ'_arrow b ∘⇩A⇘cat_Set β⇙ ?cf_hom_lhs :
Hom ?c𝔎_𝔄 (cf_map (?cf_c𝔎_𝔄 a)) (cf_map ?𝔗_c𝔎) ↦⇘cat_Set β⇙
?L_10_5_N⦇ObjMap⦈⦇b⦈"
by
(
cs_concl
cs_simp:
cat_Kan_cs_simps
cat_cs_simps
cat_FUNCT_cs_simps
cat_Funct_components(1)
cat_op_simps
cs_intro:
cat_Kan_cs_intros
cat_small_cs_intros
cat_FUNCT_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_op_intros
)
then have dom_lhs:
"𝒟⇩∘ ((?L_10_5_χ'_arrow b ∘⇩A⇘cat_Set β⇙ ?cf_hom_lhs)⦇ArrVal⦈) =
Hom ?c𝔎_𝔄 (cf_map (?cf_c𝔎_𝔄 a)) (cf_map ?𝔗_c𝔎)"
by (cs_concl cs_simp: cat_cs_simps)
from that assms β_c𝔎_𝔄.category_axioms c𝔎_𝔄.category_axioms have rhs:
"?cf_hom_rhs ∘⇩A⇘cat_Set β⇙ ?L_10_5_χ'_arrow a :
Hom ?c𝔎_𝔄 (cf_map (?cf_c𝔎_𝔄 a)) (cf_map ?𝔗_c𝔎) ↦⇘cat_Set β⇙
?L_10_5_N⦇ObjMap⦈⦇b⦈"
by
(
cs_concl
cs_simp:
cat_Kan_cs_simps
cat_cs_simps
cat_Funct_components(1)
cat_op_simps
cs_intro:
cat_Kan_cs_intros
cat_small_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
)
then have dom_rhs:
"𝒟⇩∘ ((?cf_hom_rhs ∘⇩A⇘cat_Set β⇙ ?L_10_5_χ'_arrow a)⦇ArrVal⦈) =
Hom ?c𝔎_𝔄 (cf_map (?cf_c𝔎_𝔄 a)) (cf_map ?𝔗_c𝔎)"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI)
from lhs show arr_Set_lhs:
"arr_Set β (?L_10_5_χ'_arrow b ∘⇩A⇘cat_Set β⇙ ?cf_hom_lhs)"
by (auto dest: cat_Set_is_arrD(1))
from rhs show arr_Set_rhs:
"arr_Set β (?cf_hom_rhs ∘⇩A⇘cat_Set β⇙ ?L_10_5_χ'_arrow a)"
by (auto dest: cat_Set_is_arrD(1))
show
"(?L_10_5_χ'_arrow b ∘⇩A⇘cat_Set β⇙ ?cf_hom_lhs)⦇ArrVal⦈ =
(?cf_hom_rhs ∘⇩A⇘cat_Set β⇙ ?L_10_5_χ'_arrow a)⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
fix F assume prems: "F : cf_map (?cf_c𝔎_𝔄 a) ↦⇘?c𝔎_𝔄⇙ cf_map ?𝔗_c𝔎"
let ?F = ‹ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 F›
from that have [cat_cs_simps]:
"cf_of_cf_map (c ↓⇩C⇩F 𝔎) 𝔄 (cf_map (?cf_c𝔎_𝔄 a)) = ?cf_c𝔎_𝔄 a"
"cf_of_cf_map (c ↓⇩C⇩F 𝔎) 𝔄 (cf_map (?𝔗_c𝔎)) = ?𝔗_c𝔎"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
note F = cat_Funct_is_arrD[OF prems, unfolded cat_cs_simps]
from that F(1) have F_const_is_cat_cone:
"?F ∙⇩N⇩T⇩C⇩F ?ntcf_c𝔎_𝔄 f : b <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ?𝔗_c𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_small_cs_intros is_cat_coneI cat_cs_intros
)
have [cat_cs_simps]:
"?L_10_5_υ (ntcf_arrow (?F ∙⇩N⇩T⇩C⇩F ?ntcf_c𝔎_𝔄 f)) b =
?H_f ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔗 ∙⇩N⇩T⇩C⇩F ?L_10_5_υ (ntcf_arrow ?F) a"
proof(rule ntcf_eqI)
from assms that F(1) show
"?L_10_5_υ (ntcf_arrow (?F ∙⇩N⇩T⇩C⇩F ?ntcf_c𝔎_𝔄 f)) b :
?H_ℭ c ∘⇩C⇩F 𝔎 ↦⇩C⇩F ?H_𝔄 b ∘⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by
(
cs_concl cs_intro:
cat_small_cs_intros
cat_Kan_cs_intros
cat_cs_intros
is_cat_coneI
)
then have dom_υ:
"𝒟⇩∘ (?L_10_5_υ (ntcf_arrow (?F ∙⇩N⇩T⇩C⇩F ?ntcf_c𝔎_𝔄 f)) b⦇NTMap⦈) =
𝔅⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
from assms that F(1) show
"?H_f ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔗 ∙⇩N⇩T⇩C⇩F ?L_10_5_υ (ntcf_arrow ?F) a :
?H_ℭ c ∘⇩C⇩F 𝔎 ↦⇩C⇩F ?H_𝔄 b ∘⇩C⇩F 𝔗 : 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by
(
cs_concl cs_intro:
cat_Kan_cs_intros cat_cs_intros is_cat_coneI
)
then have dom_f𝔗υ:
"𝒟⇩∘ ((?H_f ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔗 ∙⇩N⇩T⇩C⇩F ?L_10_5_υ (ntcf_arrow ?F) a)⦇NTMap⦈) =
𝔅⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
show
"?L_10_5_υ (ntcf_arrow (?F ∙⇩N⇩T⇩C⇩F ?ntcf_c𝔎_𝔄 f)) b⦇NTMap⦈ =
(?H_f ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔗 ∙⇩N⇩T⇩C⇩F ?L_10_5_υ (ntcf_arrow ?F) a)⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_υ dom_f𝔗υ)
fix b' assume prems': "b' ∈⇩∘ 𝔅⦇Obj⦈"
let ?Y = ‹Yoneda_component (?H_𝔄 b) a f (𝔗⦇ObjMap⦈⦇b'⦈)›
let ?𝔎b' = ‹𝔎⦇ObjMap⦈⦇b'⦈›
let ?𝔗b' = ‹𝔗⦇ObjMap⦈⦇b'⦈›
have [cat_cs_simps]:
"?L_10_5_υ_arrow (ntcf_arrow (?F ∙⇩N⇩T⇩C⇩F ?ntcf_c𝔎_𝔄 f)) b b' =
?Y ∘⇩A⇘cat_Set α⇙ ?L_10_5_υ_arrow (ntcf_arrow ?F) a b'"
(is ‹?υ_Ffbb' = ?Yυ›)
proof-
from assms prems' F_const_is_cat_cone have υ_Ffbb':
"?υ_Ffbb' : Hom ℭ c ?𝔎b' ↦⇘cat_Set α⇙ Hom 𝔄 b ?𝔗b'"
by
(
cs_concl cs_intro:
cat_cs_intros L_10_5_υ_arrow_is_arr
)
then have dom_υ_Ffbb': "𝒟⇩∘ (?υ_Ffbb'⦇ArrVal⦈) = Hom ℭ c (?𝔎b')"
by (cs_concl cs_simp: cat_cs_simps)
from assms that 𝔗.HomCod.category_axioms prems' F(1) have Yυ:
"?Yυ : Hom ℭ c ?𝔎b' ↦⇘cat_Set α⇙ Hom 𝔄 b ?𝔗b'"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_cs_simps cat_op_simps
cs_intro: is_cat_coneI cat_Kan_cs_intros cat_cs_intros
)
then have dom_Yυ: "𝒟⇩∘ (?Yυ⦇ArrVal⦈) = Hom ℭ c (?𝔎b')"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI)
from υ_Ffbb' show arr_Set_υ_Ffbb': "arr_Set α ?υ_Ffbb'"
by (auto dest: cat_Set_is_arrD(1))
from Yυ show arr_Set_Yυ: "arr_Set α ?Yυ"
by (auto dest: cat_Set_is_arrD(1))
show "?υ_Ffbb'⦇ArrVal⦈ = ?Yυ⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_υ_Ffbb' dom_Yυ in_Hom_iff)
fix g assume "g : c ↦⇘ℭ⇙ ?𝔎b'"
with
assms(2-)
𝔎.is_functor_axioms
𝔗.is_functor_axioms
𝔗.HomCod.category_axioms
𝔎.HomCod.category_axioms
that prems' F(1)
show "?υ_Ffbb'⦇ArrVal⦈⦇g⦈ = ?Yυ⦇ArrVal⦈⦇g⦈"
by
(
cs_concl
cs_simp:
cat_Kan_cs_simps
cat_cs_simps
L_10_5_υ_arrow_ArrVal_app
cat_comma_cs_simps
cat_op_simps
cs_intro:
cat_Kan_cs_intros
is_cat_coneI
cat_cs_intros
cat_comma_cs_intros
cat_op_intros
cs_simp: cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros
)
qed (use arr_Set_υ_Ffbb' arr_Set_Yυ in auto)
qed (use υ_Ffbb' Yυ in ‹cs_concl cs_simp: cat_cs_simps›)+
qed
from assms prems' that F(1) show
"?L_10_5_υ (ntcf_arrow (?F ∙⇩N⇩T⇩C⇩F ?ntcf_c𝔎_𝔄 f)) b⦇NTMap⦈⦇b'⦈ =
(?H_f ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔗 ∙⇩N⇩T⇩C⇩F ?L_10_5_υ (ntcf_arrow ?F) a)⦇NTMap⦈⦇b'⦈"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_cs_simps
cs_intro: is_cat_coneI cat_Kan_cs_intros cat_cs_intros
)
qed (cs_concl cs_intro: cat_Kan_cs_intros cat_cs_intros)+
qed simp_all
from that F(1) interpret F: is_cat_cone α a ‹c ↓⇩C⇩F 𝔎› 𝔄 ‹?𝔗_c𝔎› ?F
by (cs_concl cs_intro: is_cat_coneI cat_cs_intros)
from
assms(2-) prems F(1) that
𝔗.HomCod.cat_ntcf_Hom_snd_is_ntcf[OF that]
β_c𝔎_𝔄.category_axioms
show
"(?L_10_5_χ'_arrow b ∘⇩A⇘cat_Set β⇙ ?cf_hom_lhs)⦇ArrVal⦈⦇F⦈ =
(?cf_hom_rhs ∘⇩A⇘cat_Set β⇙ ?L_10_5_χ'_arrow a)⦇ArrVal⦈⦇F⦈"
by (subst (1 2) F(2))
(
cs_concl
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_FUNCT_cs_simps
cat_Funct_components(1)
cat_op_simps
cs_intro:
cat_small_cs_intros
is_cat_coneI
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
)
qed (use arr_Set_lhs arr_Set_rhs in auto)
qed (use lhs rhs in ‹cs_concl cs_simp: cat_cs_simps›)+
qed
show
"?L_10_5_χ⦇NTMap⦈⦇b⦈ ∘⇩A⇘cat_Set β⇙ ?cf_Cone⦇ArrMap⦈⦇f⦈ =
?L_10_5_N⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set β⇙ ?L_10_5_χ⦇NTMap⦈⦇a⦈"
if "f : b ↦⇘𝔄⇙ a" for a b f
using that assms
by
(
cs_concl
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_Funct_components(1)
cat_FUNCT_cs_simps
cat_op_simps
cs_intro:
cat_small_cs_intros
cat_Kan_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
)
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
subsection‹
The limit of ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎› exists for every
pointwise right Kan extension of ‹𝔗› along ‹𝔎›
›
lemma (in is_cat_pw_rKe) cat_pw_rKe_ex_cat_limit:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
obtains UA
where "UA : 𝔊⦇ObjMap⦈⦇c⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
proof-
define β where "β = α + ω"
have β: "𝒵 β" and αβ: "α ∈⇩∘ β"
by (simp_all add: β_def AG.𝒵_Limit_αω AG.𝒵_ω_αω 𝒵_def AG.𝒵_α_αω)
then interpret β: 𝒵 β by simp
let ?FUNCT = ‹λ𝔄. cat_FUNCT α 𝔄 (cat_Set α)›
let ?H_A = ‹λf. Hom⇩A⇩.⇩C⇘α⇙𝔄(f,-)›
let ?H_A𝔊 = ‹λf. ?H_A f ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔊›
let ?H_𝔄 = ‹λa. Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-)›
let ?H_𝔄𝔗 = ‹λa. ?H_𝔄 a ∘⇩C⇩F 𝔗›
let ?H_𝔄𝔊 = ‹λa. ?H_𝔄 a ∘⇩C⇩F 𝔊›
let ?H_ℭ = ‹λc. Hom⇩O⇩.⇩C⇘α⇙ℭ(c,-)›
let ?H_ℭ𝔎 = ‹λc. ?H_ℭ c ∘⇩C⇩F 𝔎›
let ?H_𝔄ε = ‹λb. ?H_𝔄 b ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ε›
let ?SET_𝔎 = ‹exp_cat_cf α (cat_Set α) 𝔎›
let ?H_FUNCT = ‹λℭ 𝔉. Hom⇩O⇩.⇩C⇘β⇙?FUNCT ℭ(-,cf_map 𝔉)›
let ?ua_NTDGDom = ‹op_cat (?FUNCT ℭ)›
let ?ua_NTDom = ‹λa. ?H_FUNCT ℭ (?H_𝔄𝔊 a)›
let ?ua_NTCod = ‹λa. ?H_FUNCT 𝔅 (?H_𝔄𝔗 a) ∘⇩C⇩F op_cf ?SET_𝔎›
let ?c𝔎_𝔄 = ‹cat_Funct α (c ↓⇩C⇩F 𝔎) 𝔄›
let ?ua =
‹
λa. ntcf_ua_fo
β
?SET_𝔎
(cf_map (?H_𝔄𝔗 a))
(cf_map (?H_𝔄𝔊 a))
(ntcf_arrow (?H_𝔄ε a))
›
let ?cf_nt = ‹cf_nt α β (cf_id ℭ)›
let ?cf_eval = ‹cf_eval α β ℭ›
let ?𝔗_c𝔎 = ‹𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎›
let ?cf_c𝔎_𝔄 = ‹cf_const (c ↓⇩C⇩F 𝔎) 𝔄›
let ?𝔊c = ‹𝔊⦇ObjMap⦈⦇c⦈›
let ?Δ = ‹Δ⇩C α (c ↓⇩C⇩F 𝔎) 𝔄›
let ?ntcf_ua_fo =
‹
λa. ntcf_ua_fo
β
?SET_𝔎
(cf_map (?H_𝔄𝔗 a))
(cf_map (?H_𝔄𝔊 a))
(ntcf_arrow (?H_𝔄ε a))
›
let ?umap_fo =
‹
λb. umap_fo
?SET_𝔎
(cf_map (?H_𝔄𝔗 b))
(cf_map (?H_𝔄𝔊 b))
(ntcf_arrow (?H_𝔄ε b))
(cf_map (?H_ℭ c))
›
interpret 𝔎: is_tm_functor α 𝔅 ℭ 𝔎 by (rule assms(1))
interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
from AG.vempty_is_zet assms(3) interpret c𝔎: tiny_category α ‹c ↓⇩C⇩F 𝔎›
by (cs_concl cs_intro: cat_comma_cs_intros)
from αβ assms(3) interpret c𝔎_𝔄: category α ?c𝔎_𝔄
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
interpret β_c𝔎_𝔄: category β ?c𝔎_𝔄
by (rule c𝔎_𝔄.cat_category_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros αβ)+
from αβ assms(3) interpret Δ: is_functor α 𝔄 ?c𝔎_𝔄 ?Δ
by
(
cs_concl cs_intro:
cat_small_cs_intros cat_cs_intros cat_op_intros
)+
from Δ.is_functor_axioms αβ interpret βΔ:
is_functor β 𝔄 ‹?c𝔎_𝔄› ‹?Δ›
by (cs_intro_step is_functor.cf_is_functor_if_ge_Limit)
(cs_concl cs_intro: cat_cs_intros)+
from AG.vempty_is_zet assms(3) interpret Πc:
is_tm_functor α ‹c ↓⇩C⇩F 𝔎› 𝔅 ‹c ⇩O⨅⇩C⇩F 𝔎›
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
)
interpret βΠc: is_tiny_functor β ‹c ↓⇩C⇩F 𝔎› 𝔅 ‹c ⇩O⨅⇩C⇩F 𝔎›
by (rule Πc.cf_is_tiny_functor_if_ge_Limit[OF β αβ])
interpret E: is_functor β ‹?FUNCT ℭ ×⇩C ℭ› ‹cat_Set β› ?cf_eval
by (rule AG.HomCod.cat_cf_eval_is_functor[OF β αβ])
from αβ interpret FUNCT_𝔄: tiny_category β ‹?FUNCT 𝔄›
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from αβ interpret FUNCT_𝔅: tiny_category β ‹?FUNCT 𝔅›
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
from αβ interpret FUNCT_ℭ: tiny_category β ‹?FUNCT ℭ›
by (cs_concl cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
interpret β𝔄: tiny_category β 𝔄
by (rule category.cat_tiny_category_if_ge_Limit)
(use αβ in ‹cs_concl cs_intro: cat_cs_intros›)+
interpret β𝔅: tiny_category β 𝔅
by (rule category.cat_tiny_category_if_ge_Limit)
(use αβ in ‹cs_concl cs_intro: cat_cs_intros›)+
interpret βℭ: tiny_category β ℭ
by (rule category.cat_tiny_category_if_ge_Limit)
(use αβ in ‹cs_concl cs_intro: cat_cs_intros›)+
interpret β𝔎: is_tiny_functor β 𝔅 ℭ 𝔎
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use αβ in ‹cs_concl cs_intro: cat_cs_intros›)+
interpret β𝔊: is_tiny_functor β ℭ 𝔄 𝔊
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use αβ in ‹cs_concl cs_intro: cat_cs_intros›)+
interpret β𝔗: is_tiny_functor β 𝔅 𝔄 𝔗
by (rule is_functor.cf_is_tiny_functor_if_ge_Limit)
(use αβ in ‹cs_concl cs_intro: cat_cs_intros›)+
interpret cat_Set_αβ: subcategory β ‹cat_Set α› ‹cat_Set β›
by (rule AG.subcategory_cat_Set_cat_Set[OF β αβ])
from assms(3) αβ interpret Hom_c: is_functor α ℭ ‹cat_Set α› ‹?H_ℭ c›
by (cs_concl cs_intro: cat_cs_intros)
define E' :: V where "E' =
[
(λa∈⇩∘𝔄⦇Obj⦈. ?cf_eval⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈⇩∙),
(λf∈⇩∘𝔄⦇Arr⦈. ?cf_eval⦇ArrMap⦈⦇ntcf_arrow (?H_A𝔊 f), ℭ⦇CId⦈⦇c⦈⦈⇩∙),
op_cat 𝔄,
cat_Set β
]⇩∘ "
have E'_components:
"E'⦇ObjMap⦈ = (λa∈⇩∘𝔄⦇Obj⦈. ?cf_eval⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈⇩∙)"
"E'⦇ArrMap⦈ =
(λf∈⇩∘𝔄⦇Arr⦈. ?cf_eval⦇ArrMap⦈⦇ntcf_arrow (?H_A𝔊 f), ℭ⦇CId⦈⦇c⦈⦈⇩∙)"
"E'⦇HomDom⦈ = op_cat 𝔄"
"E'⦇HomCod⦈ = cat_Set β"
unfolding E'_def dghm_field_simps by (simp_all add: nat_omega_simps)
note [cat_cs_simps] = E'_components(3,4)
have E'_ObjMap_app[cat_cs_simps]:
"E'⦇ObjMap⦈⦇a⦈ = ?cf_eval⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈⇩∙"
if "a ∈⇩∘ 𝔄⦇Obj⦈" for a
using that unfolding E'_components by simp
have E'_ArrMap_app[cat_cs_simps]:
"E'⦇ArrMap⦈⦇f⦈ = ?cf_eval⦇ArrMap⦈⦇ntcf_arrow (?H_A𝔊 f), ℭ⦇CId⦈⦇c⦈⦈⇩∙"
if "f ∈⇩∘ 𝔄⦇Arr⦈" for f
using that unfolding E'_components by simp
have E': "E' : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
proof(intro is_functorI')
show "vfsequence E'" unfolding E'_def by auto
show "vcard E' = 4⇩ℕ" unfolding E'_def by (simp add: nat_omega_simps)
show "vsv (E'⦇ObjMap⦈)" unfolding E'_components by simp
show "vsv (E'⦇ArrMap⦈)" unfolding E'_components by simp
show "𝒟⇩∘ (E'⦇ObjMap⦈) = op_cat 𝔄⦇Obj⦈"
unfolding E'_components by (simp add: cat_op_simps)
show "ℛ⇩∘ (E'⦇ObjMap⦈) ⊆⇩∘ cat_Set β⦇Obj⦈"
unfolding E'_components
proof(rule vrange_VLambda_vsubset)
fix a assume prems: "a ∈⇩∘ 𝔄⦇Obj⦈"
then have "?H_𝔄𝔊 a : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
with assms(3) prems show
"?cf_eval⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈⇩∙ ∈⇩∘ cat_Set β⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Set_components(1)
cs_intro: cat_cs_intros cat_op_intros Ran.HomCod.cat_Hom_in_Vset
)
qed
show "𝒟⇩∘ (E'⦇ArrMap⦈) = op_cat 𝔄⦇Arr⦈"
unfolding E'_components by (simp add: cat_op_simps)
show "E'⦇ArrMap⦈⦇f⦈ : E'⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set β⇙ E'⦇ObjMap⦈⦇b⦈"
if "f : a ↦⇘op_cat 𝔄⇙ b" for a b f
proof-
from that[unfolded cat_op_simps] assms(3) show ?thesis
by (intro cat_Set_αβ.subcat_is_arrD)
(
cs_concl
cs_simp:
category.cf_eval_ObjMap_app
category.cf_eval_ArrMap_app
E'_ObjMap_app
E'_ArrMap_app
cs_intro: cat_cs_intros
)
qed
then have [cat_cs_intros]: "E'⦇ArrMap⦈⦇f⦈ : A ↦⇘cat_Set β⇙ B"
if "A = E'⦇ObjMap⦈⦇a⦈" and "B = E'⦇ObjMap⦈⦇b⦈" and "f : b ↦⇘𝔄⇙ a"
for a b f A B
using that by (simp add: cat_op_simps)
show
"E'⦇ArrMap⦈⦇g ∘⇩A⇘op_cat 𝔄⇙ f⦈ = E'⦇ArrMap⦈⦇g⦈ ∘⇩A⇘cat_Set β⇙ E'⦇ArrMap⦈⦇f⦈"
if "g : b ↦⇘op_cat 𝔄⇙ c" and "f : a ↦⇘op_cat 𝔄⇙ b" for b c g a f
proof-
note g = that(1)[unfolded cat_op_simps]
and f = that(2)[unfolded cat_op_simps]
from g f assms(3) αβ show ?thesis
by
(
cs_concl
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
cs_simp:
cat_cs_simps
cat_FUNCT_cs_simps
cat_prod_cs_simps
cat_op_simps
E.cf_ArrMap_Comp[symmetric]
)+
qed
show "E'⦇ArrMap⦈⦇op_cat 𝔄⦇CId⦈⦇a⦈⦈ = cat_Set β⦇CId⦈⦇E'⦇ObjMap⦈⦇a⦈⦈"
if "a ∈⇩∘ op_cat 𝔄⦇Obj⦈" for a
proof(cs_concl_step cat_Set_αβ.subcat_CId[symmetric])
from that[unfolded cat_op_simps] assms(3) show
"E'⦇ObjMap⦈⦇a⦈ ∈⇩∘ cat_Set α⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_Set_components(1) cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros
)
from that[unfolded cat_op_simps] assms(3) show
"E'⦇ArrMap⦈⦇op_cat 𝔄⦇CId⦈⦇a⦈⦈ = cat_Set α⦇CId⦈⦇E'⦇ObjMap⦈⦇a⦈⦈"
by
(
cs_concl
cs_intro: cat_cs_intros
cs_simp:
cat_Set_components(1)
cat_cs_simps
cat_op_simps
ntcf_id_cf_comp[symmetric]
)
qed
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
then interpret E': is_functor β ‹op_cat 𝔄› ‹cat_Set β› E' by simp
define N' :: V where "N' =
[
(λa∈⇩∘𝔄⦇Obj⦈. ?cf_nt⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈⇩∙),
(λf∈⇩∘𝔄⦇Arr⦈. ?cf_nt⦇ArrMap⦈⦇ntcf_arrow (?H_A𝔊 f), ℭ⦇CId⦈⦇c⦈⦈⇩∙),
op_cat 𝔄,
cat_Set β
]⇩∘ "
have N'_components:
"N'⦇ObjMap⦈ = (λa∈⇩∘𝔄⦇Obj⦈. ?cf_nt⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈⇩∙)"
"N'⦇ArrMap⦈ =
(λf∈⇩∘𝔄⦇Arr⦈. ?cf_nt⦇ArrMap⦈⦇ntcf_arrow (?H_A𝔊 f), ℭ⦇CId⦈⦇c⦈⦈⇩∙)"
"N'⦇HomDom⦈ = op_cat 𝔄"
"N'⦇HomCod⦈ = cat_Set β"
unfolding N'_def dghm_field_simps by (simp_all add: nat_omega_simps)
note [cat_cs_simps] = N'_components(3,4)
have N'_ObjMap_app[cat_cs_simps]:
"N'⦇ObjMap⦈⦇a⦈ = ?cf_nt⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈⇩∙"
if "a ∈⇩∘ 𝔄⦇Obj⦈" for a
using that unfolding N'_components by simp
have N'_ArrMap_app[cat_cs_simps]:
"N'⦇ArrMap⦈⦇f⦈ = ?cf_nt⦇ArrMap⦈⦇ntcf_arrow (?H_A𝔊 f), ℭ⦇CId⦈⦇c⦈⦈⇩∙"
if "f ∈⇩∘ 𝔄⦇Arr⦈" for f
using that unfolding N'_components by simp
from αβ interpret cf_nt_ℭ: is_functor β ‹?FUNCT ℭ ×⇩C ℭ› ‹cat_Set β› ‹?cf_nt›
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have N': "N' : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
proof(intro is_functorI')
show "vfsequence N'" unfolding N'_def by simp
show "vcard N' = 4⇩ℕ" unfolding N'_def by (simp add: nat_omega_simps)
show "vsv (N'⦇ObjMap⦈)" unfolding N'_components by simp
show "vsv (N'⦇ArrMap⦈)" unfolding N'_components by simp
show "𝒟⇩∘ (N'⦇ObjMap⦈) = op_cat 𝔄⦇Obj⦈"
unfolding N'_components by (simp add: cat_op_simps)
show "ℛ⇩∘ (N'⦇ObjMap⦈) ⊆⇩∘ cat_Set β⦇Obj⦈"
unfolding N'_components
proof(rule vrange_VLambda_vsubset)
fix a assume prems: "a ∈⇩∘ 𝔄⦇Obj⦈"
with assms(3) αβ show
"?cf_nt⦇ObjMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈⇩∙ ∈⇩∘ cat_Set β⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_Set_components(1) cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros FUNCT_ℭ.cat_Hom_in_Vset cat_FUNCT_cs_intros
)
qed
show "𝒟⇩∘ (N'⦇ArrMap⦈) = op_cat 𝔄⦇Arr⦈"
unfolding N'_components by (simp add: cat_op_simps)
show "N'⦇ArrMap⦈⦇f⦈ : N'⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set β⇙ N'⦇ObjMap⦈⦇b⦈"
if "f : a ↦⇘op_cat 𝔄⇙ b" for a b f
using that[unfolded cat_op_simps] assms(3)
by
(
cs_concl
cs_simp: N'_ObjMap_app N'_ArrMap_app
cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
)
show
"N'⦇ArrMap⦈⦇g ∘⇩A⇘op_cat 𝔄⇙ f⦈ = N'⦇ArrMap⦈⦇g⦈ ∘⇩A⇘cat_Set β⇙ N'⦇ArrMap⦈⦇f⦈"
if "g : b ↦⇘op_cat 𝔄⇙ c" and "f : a ↦⇘op_cat 𝔄⇙ b" for b c g a f
proof-
from that assms(3) αβ show ?thesis
unfolding cat_op_simps
by
(
cs_concl
cs_intro:
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
cs_simp:
cat_cs_simps
cat_FUNCT_cs_simps
cat_prod_cs_simps
cat_op_simps
cf_nt_ℭ.cf_ArrMap_Comp[symmetric]
)
qed
show "N'⦇ArrMap⦈⦇op_cat 𝔄⦇CId⦈⦇a⦈⦈ = cat_Set β⦇CId⦈⦇N'⦇ObjMap⦈⦇a⦈⦈"
if "a ∈⇩∘ op_cat 𝔄⦇Obj⦈" for a
proof-
note [cat_cs_simps] =
ntcf_id_cf_comp[symmetric]
ntcf_arrow_id_ntcf_id[symmetric]
cat_FUNCT_CId_app[symmetric]
from that[unfolded cat_op_simps] assms(3) αβ show ?thesis
by
(
cs_concl
cs_intro:
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
cs_simp: cat_FUNCT_cs_simps cat_cs_simps cat_op_simps
)+
qed
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
then interpret N': is_functor β ‹op_cat 𝔄› ‹cat_Set β› N' by simp
define Y' :: V where "Y' =
[
(λa∈⇩∘𝔄⦇Obj⦈. ntcf_Yoneda α β ℭ⦇NTMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈⇩∙),
N',
E',
op_cat 𝔄,
cat_Set β
]⇩∘"
have Y'_components:
"Y'⦇NTMap⦈ = (λa∈⇩∘𝔄⦇Obj⦈. ntcf_Yoneda α β ℭ⦇NTMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈⇩∙)"
"Y'⦇NTDom⦈ = N'"
"Y'⦇NTCod⦈ = E'"
"Y'⦇NTDGDom⦈ = op_cat 𝔄"
"Y'⦇NTDGCod⦈ = cat_Set β"
unfolding Y'_def nt_field_simps by (simp_all add: nat_omega_simps)
note [cat_cs_simps] = Y'_components(2-5)
have Y'_NTMap_app[cat_cs_simps]:
"Y'⦇NTMap⦈⦇a⦈ = ntcf_Yoneda α β ℭ⦇NTMap⦈⦇cf_map (?H_𝔄𝔊 a), c⦈⇩∙"
if "a ∈⇩∘ 𝔄⦇Obj⦈" for a
using that unfolding Y'_components by simp
from β αβ interpret Y:
is_iso_ntcf β ‹?FUNCT ℭ ×⇩C ℭ› ‹cat_Set β› ?cf_nt ?cf_eval ‹ntcf_Yoneda α β ℭ›
by (rule AG.HomCod.cat_ntcf_Yoneda_is_ntcf)
have Y': "Y' : N' ↦⇩C⇩F⇩.⇩i⇩s⇩o E' : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
proof(intro is_iso_ntcfI is_ntcfI')
show "vfsequence Y'" unfolding Y'_def by simp
show "vcard Y' = 5⇩ℕ"
unfolding Y'_def by (simp add: nat_omega_simps)
show "vsv (Y'⦇NTMap⦈)" unfolding Y'_components by auto
show "𝒟⇩∘ (Y'⦇NTMap⦈) = op_cat 𝔄⦇Obj⦈"
unfolding Y'_components by (simp add: cat_op_simps)
show Y'_NTMap_a: "Y'⦇NTMap⦈⦇a⦈ : N'⦇ObjMap⦈⦇a⦈ ↦⇩i⇩s⇩o⇘cat_Set β⇙ E'⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ op_cat 𝔄⦇Obj⦈" for a
using that[unfolded cat_op_simps] assms(3)
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro:
cat_arrow_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
)
then show "Y'⦇NTMap⦈⦇a⦈ : N'⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set β⇙ E'⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ op_cat 𝔄⦇Obj⦈" for a
by (intro cat_Set_is_arr_isomorphismD[OF Y'_NTMap_a[OF that]])
show
"Y'⦇NTMap⦈⦇b⦈ ∘⇩A⇘cat_Set β⇙ N'⦇ArrMap⦈⦇f⦈ =
E'⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set β⇙ Y'⦇NTMap⦈⦇a⦈"
if "f : a ↦⇘op_cat 𝔄⇙ b" for a b f
proof-
note f = that[unfolded cat_op_simps]
from f assms(3) show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps Y.ntcf_Comp_commute
cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
)+
qed
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
have E'_def: "E' = Hom⇩O⇩.⇩C⇘β⇙𝔄(-,?𝔊c)"
proof(rule cf_eqI)
show "E' : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
by (cs_concl cs_intro: cat_cs_intros)
from assms(3) show
"Hom⇩O⇩.⇩C⇘β⇙𝔄(-,?𝔊c) : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have dom_lhs: "𝒟⇩∘ (E'⦇ObjMap⦈) = 𝔄⦇Obj⦈" unfolding E'_components by simp
from assms(3) have dom_rhs:
"𝒟⇩∘ (Hom⇩O⇩.⇩C⇘β⇙𝔄(-,?𝔊c)⦇ObjMap⦈) = 𝔄⦇Obj⦈"
unfolding E'_components
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
show "E'⦇ObjMap⦈ = Hom⇩O⇩.⇩C⇘β⇙𝔄(-,?𝔊c)⦇ObjMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume "a ∈⇩∘ 𝔄⦇Obj⦈"
with assms(3) show "E'⦇ObjMap⦈⦇a⦈ = Hom⇩O⇩.⇩C⇘β⇙𝔄(-,?𝔊c)⦇ObjMap⦈⦇a⦈"
by
(
cs_concl
cs_simp: cat_op_simps cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed (auto simp: E'_components cat_cs_intros assms(3))
have dom_lhs: "𝒟⇩∘ (E'⦇ArrMap⦈) = 𝔄⦇Arr⦈" unfolding E'_components by simp
from assms(3) have dom_rhs:
"𝒟⇩∘ (Hom⇩O⇩.⇩C⇘β⇙𝔄(-,?𝔊c)⦇ArrMap⦈) = 𝔄⦇Arr⦈"
unfolding E'_components
by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
show "E'⦇ArrMap⦈ = Hom⇩O⇩.⇩C⇘β⇙𝔄(-,?𝔊c)⦇ArrMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix f assume prems: "f ∈⇩∘ 𝔄⦇Arr⦈"
then obtain a b where f: "f : a ↦⇘𝔄⇙ b" by auto
have [cat_cs_simps]:
"cf_eval_arrow ℭ (ntcf_arrow (?H_A𝔊 f)) (ℭ⦇CId⦈⦇c⦈) =
cf_hom 𝔄 [f, 𝔄⦇CId⦈⦇?𝔊c⦈]⇩∘"
(is ‹?cf_eval_arrow = ?cf_hom_f𝔊c›)
proof-
have cf_eval_arrow_f_CId_𝔊c:
"?cf_eval_arrow :
Hom 𝔄 b ?𝔊c ↦⇘cat_Set α⇙ Hom 𝔄 a ?𝔊c"
proof(rule cf_eval_arrow_is_arr')
from f show "?H_A𝔊 f :
?H_𝔄𝔊 b ↦⇩C⇩F ?H_𝔄𝔊 a : ℭ ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_intro: cat_cs_intros)
qed
(
use f assms(3) in
‹
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
›
)+
from f assms(3) have dom_lhs:
"𝒟⇩∘ (?cf_eval_arrow⦇ArrVal⦈) = Hom 𝔄 b ?𝔊c"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
from assms(3) f Ran.HomCod.category_axioms have cf_hom_f𝔊c:
"?cf_hom_f𝔊c :
Hom 𝔄 b ?𝔊c ↦⇘cat_Set α⇙ Hom 𝔄 a ?𝔊c"
by
(
cs_concl cs_intro:
cat_cs_intros cat_prod_cs_intros cat_op_intros
)
from f assms(3) have dom_rhs:
"𝒟⇩∘ (?cf_hom_f𝔊c⦇ArrVal⦈) = Hom 𝔄 b ?𝔊c"
by
(
cs_concl
cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
)
show ?thesis
proof(rule arr_Set_eqI)
from cf_eval_arrow_f_CId_𝔊c show "arr_Set α ?cf_eval_arrow"
by (auto dest: cat_Set_is_arrD(1))
from cf_hom_f𝔊c show "arr_Set α ?cf_hom_f𝔊c"
by (auto dest: cat_Set_is_arrD(1))
show "?cf_eval_arrow⦇ArrVal⦈ = ?cf_hom_f𝔊c⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs, unfold in_Hom_iff)
from f assms(3) show "vsv (?cf_eval_arrow⦇ArrVal⦈)"
by (cs_concl cs_intro: cat_cs_intros)
from f assms(3) show "vsv (?cf_hom_f𝔊c⦇ArrVal⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
fix g assume "g : b ↦⇘𝔄⇙ ?𝔊c"
with f assms(3) show
"?cf_eval_arrow⦇ArrVal⦈⦇g⦈ = ?cf_hom_f𝔊c⦇ArrVal⦈⦇g⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed simp
qed
(
use cf_eval_arrow_f_CId_𝔊c cf_hom_f𝔊c in
‹cs_concl cs_simp: cat_cs_simps›
)+
qed
from f prems assms(3) show
"E'⦇ArrMap⦈⦇f⦈ = Hom⇩O⇩.⇩C⇘β⇙𝔄(-,?𝔊c)⦇ArrMap⦈⦇f⦈"
by
(
cs_concl
cs_simp: cat_op_simps cat_cs_simps
cs_intro: cat_cs_intros cat_op_intros
)
qed (auto simp: E'_components cat_cs_intros assms(3))
qed simp_all
from Y' have inv_Y': "inv_ntcf Y' :
Hom⇩O⇩.⇩C⇘β⇙𝔄(-,?𝔊c) ↦⇩C⇩F⇩.⇩i⇩s⇩o N' : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
unfolding E'_def by (auto intro: iso_ntcf_is_arr_isomorphism)
interpret N'': is_functor β ‹op_cat 𝔄› ‹cat_Set β› ‹L_10_5_N α β 𝔗 𝔎 c›
by (rule L_10_5_N_is_functor[OF β αβ assms])
define ψ :: V
where "ψ =
[
(λa∈⇩∘𝔄⦇Obj⦈. ?ntcf_ua_fo a⦇NTMap⦈⦇cf_map (?H_ℭ c)⦈),
N',
L_10_5_N α β 𝔗 𝔎 c,
op_cat 𝔄,
cat_Set β
]⇩∘"
have ψ_components:
"ψ⦇NTMap⦈ = (λa∈⇩∘𝔄⦇Obj⦈. ?ntcf_ua_fo a⦇NTMap⦈⦇cf_map (?H_ℭ c)⦈)"
"ψ⦇NTDom⦈ = N'"
"ψ⦇NTCod⦈ = L_10_5_N α β 𝔗 𝔎 c"
"ψ⦇NTDGDom⦈ = op_cat 𝔄"
"ψ⦇NTDGCod⦈ = cat_Set β"
unfolding ψ_def nt_field_simps by (simp_all add: nat_omega_simps)
note [cat_cs_simps] = Y'_components(2-5)
have ψ_NTMap_app[cat_cs_simps]:
"ψ⦇NTMap⦈⦇a⦈ = ?ntcf_ua_fo a⦇NTMap⦈⦇cf_map (?H_ℭ c)⦈"
if "a ∈⇩∘ 𝔄⦇Obj⦈" for a
using that unfolding ψ_components by simp
have ψ: "ψ : N' ↦⇩C⇩F⇩.⇩i⇩s⇩o L_10_5_N α β 𝔗 𝔎 c : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
proof-
show ?thesis
proof(intro is_iso_ntcfI is_ntcfI')
show "vfsequence ψ" unfolding ψ_def by auto
show "vcard ψ = 5⇩ℕ" unfolding ψ_def by (simp_all add: nat_omega_simps)
show "N' : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β" by (rule N')
show "L_10_5_N α β 𝔗 𝔎 c : op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "ψ⦇NTDom⦈ = N'" unfolding ψ_components by simp
show "ψ⦇NTCod⦈ = L_10_5_N α β 𝔗 𝔎 c" unfolding ψ_components by simp
show "ψ⦇NTDGDom⦈ = op_cat 𝔄" unfolding ψ_components by simp
show "ψ⦇NTDGCod⦈ = cat_Set β" unfolding ψ_components by simp
show "vsv (ψ⦇NTMap⦈)" unfolding ψ_components by simp
show "𝒟⇩∘ (ψ⦇NTMap⦈) = op_cat 𝔄⦇Obj⦈"
unfolding ψ_components by (simp add: cat_op_simps)
show ψ_NTMap_is_arr_isomorphism[unfolded cat_op_simps]:
"ψ⦇NTMap⦈⦇a⦈ : N'⦇ObjMap⦈⦇a⦈ ↦⇩i⇩s⇩o⇘cat_Set β⇙ L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ op_cat 𝔄⦇Obj⦈" for a
proof-
note a = that[unfolded cat_op_simps]
interpret ε:
is_cat_rKe_preserves α 𝔅 ℭ 𝔄 ‹cat_Set α› 𝔎 𝔗 𝔊 ‹?H_𝔄 a› ε
by (rule cat_pw_rKe_preserved[OF a])
interpret aε:
is_cat_rKe α 𝔅 ℭ ‹cat_Set α› 𝔎 ‹?H_𝔄𝔗 a› ‹?H_𝔄𝔊 a› ‹?H_𝔄ε a›
by (rule ε.cat_rKe_preserves)
interpret is_iso_ntcf
β
‹op_cat (?FUNCT ℭ)›
‹cat_Set β›
‹?H_FUNCT ℭ (?H_𝔄𝔊 a)›
‹?H_FUNCT 𝔅 (?H_𝔄𝔗 a) ∘⇩C⇩F op_cf ?SET_𝔎›
‹?ntcf_ua_fo a›
by (rule aε.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF β αβ])
have "cf_map (?H_ℭ c) ∈⇩∘ ?FUNCT ℭ⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
from
iso_ntcf_is_arr_isomorphism[unfolded cat_op_simps, OF this]
a assms αβ
show ?thesis
by
(
cs_prems
cs_simp:
cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro:
cat_small_cs_intros
cat_Kan_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
)
qed
show ψ_NTMap_is_arr[unfolded cat_op_simps]:
"ψ⦇NTMap⦈⦇a⦈ : N'⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set β⇙ L_10_5_N α β 𝔗 𝔎 c⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ op_cat 𝔄⦇Obj⦈" for a
by
(
rule cat_Set_is_arr_isomorphismD[
OF ψ_NTMap_is_arr_isomorphism[OF that[unfolded cat_op_simps]]
]
)
show
"ψ⦇NTMap⦈⦇b⦈ ∘⇩A⇘cat_Set β⇙ N'⦇ArrMap⦈⦇f⦈ =
L_10_5_N α β 𝔗 𝔎 c⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set β⇙ ψ⦇NTMap⦈⦇a⦈"
if "f : a ↦⇘op_cat 𝔄⇙ b" for a b f
proof-
note f = that[unfolded cat_op_simps]
from f have a: "a ∈⇩∘ 𝔄⦇Obj⦈" and b: "b ∈⇩∘ 𝔄⦇Obj⦈" by auto
interpret p_a_ε:
is_cat_rKe_preserves α 𝔅 ℭ 𝔄 ‹cat_Set α› 𝔎 𝔗 𝔊 ‹?H_𝔄 a› ε
by (rule cat_pw_rKe_preserved[OF a])
interpret a_ε: is_cat_rKe
α 𝔅 ℭ ‹cat_Set α› 𝔎 ‹?H_𝔄𝔗 a› ‹?H_𝔄𝔊 a› ‹?H_𝔄ε a›
by (rule p_a_ε.cat_rKe_preserves)
interpret ntcf_ua_fo_a_ε: is_iso_ntcf
β ?ua_NTDGDom ‹cat_Set β› ‹?ua_NTDom a› ‹?ua_NTCod a› ‹?ua a›
by (rule a_ε.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF β αβ])
interpret p_b_ε:
is_cat_rKe_preserves α 𝔅 ℭ 𝔄 ‹cat_Set α› 𝔎 𝔗 𝔊 ‹?H_𝔄 b› ε
by (rule cat_pw_rKe_preserved[OF b])
interpret b_ε: is_cat_rKe
α 𝔅 ℭ ‹cat_Set α› 𝔎 ‹?H_𝔄𝔗 b› ‹?H_𝔄𝔊 b› ‹?H_𝔄ε b›
by (rule p_b_ε.cat_rKe_preserves)
interpret ntcf_ua_fo_b_ε: is_iso_ntcf
β ?ua_NTDGDom ‹cat_Set β› ‹?ua_NTDom b› ‹?ua_NTCod b› ‹?ua b›
by (rule b_ε.cat_rKe_ntcf_ua_fo_is_iso_ntcf_if_ge_Limit[OF β αβ])
interpret 𝔎_SET: is_tiny_functor β ‹?FUNCT ℭ› ‹?FUNCT 𝔅› ?SET_𝔎
by
(
rule exp_cat_cf_is_tiny_functor[
OF β αβ AG.category_cat_Set AG.is_functor_axioms
]
)
from f interpret Hom_f:
is_ntcf α 𝔄 ‹cat_Set α› ‹?H_𝔄 a› ‹?H_𝔄 b› ‹?H_A f›
by (cs_concl cs_intro: cat_cs_intros)
let ?cf_hom_lhs =
‹
cf_hom
(?FUNCT ℭ)
[ntcf_arrow (ntcf_id (?H_ℭ c)), ntcf_arrow (?H_A𝔊 f)]⇩∘
›
let ?cf_hom_rhs =
‹
cf_hom
(?FUNCT 𝔅)
[
ntcf_arrow (ntcf_id (?H_ℭ c ∘⇩C⇩F 𝔎)),
ntcf_arrow (?H_A f ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔗)
]⇩∘
›
let ?dom =
‹Hom (?FUNCT ℭ) (cf_map (?H_ℭ c)) (cf_map (?H_𝔄𝔊 a))›
let ?cod = ‹Hom (?FUNCT 𝔅) (cf_map (?H_ℭ𝔎 c)) (cf_map (?H_𝔄𝔗 b))›
let ?cf_hom_lhs_umap_fo_inter =
‹Hom (?FUNCT ℭ) (cf_map (?H_ℭ c)) (cf_map (?H_𝔄𝔊 b))›
let ?umap_fo_cf_hom_rhs_inter =
‹Hom (?FUNCT 𝔅) (cf_map (?H_ℭ𝔎 c)) (cf_map (?H_𝔄𝔗 a))›
have [cat_cs_simps]:
"?umap_fo b ∘⇩A⇘cat_Set β⇙ ?cf_hom_lhs =
?cf_hom_rhs ∘⇩A⇘cat_Set β⇙ ?umap_fo a"
proof-
from f assms(3) αβ have cf_hom_lhs:
"?cf_hom_lhs : ?dom ↦⇘cat_Set β⇙ ?cf_hom_lhs_umap_fo_inter"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro:
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
from f assms(3) αβ have umap_fo_b:
"?umap_fo b : ?cf_hom_lhs_umap_fo_inter ↦⇘cat_Set β⇙ ?cod"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
from cf_hom_lhs umap_fo_b have umap_fo_cf_hom_lhs:
"?umap_fo b ∘⇩A⇘cat_Set β⇙ ?cf_hom_lhs : ?dom ↦⇘cat_Set β⇙ ?cod"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
then have dom_umap_fo_cf_hom_lhs:
"𝒟⇩∘ ((?umap_fo b ∘⇩A⇘cat_Set β⇙ ?cf_hom_lhs)⦇ArrVal⦈) = ?dom"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
from f assms(3) αβ have cf_hom_rhs:
"?cf_hom_rhs : ?umap_fo_cf_hom_rhs_inter ↦⇘cat_Set β⇙ ?cod"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro:
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
from f assms(3) αβ have umap_fo_a:
"?umap_fo a : ?dom ↦⇘cat_Set β⇙ ?umap_fo_cf_hom_rhs_inter"
by
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro:
cat_small_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_prod_cs_intros
cat_op_intros
)
from cf_hom_rhs umap_fo_a have cf_hom_rhs_umap_fo_a:
"?cf_hom_rhs ∘⇩A⇘cat_Set β⇙ ?umap_fo a : ?dom ↦⇘cat_Set β⇙ ?cod"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros )
then have dom_cf_hom_rhs_umap_fo_a:
"𝒟⇩∘ ((?cf_hom_rhs ∘⇩A⇘cat_Set β⇙ ?umap_fo a)⦇ArrVal⦈) = ?dom"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show ?thesis
proof(rule arr_Set_eqI)
from umap_fo_cf_hom_lhs show arr_Set_umap_fo_cf_hom_lhs:
"arr_Set β (?umap_fo b ∘⇩A⇘cat_Set β⇙ ?cf_hom_lhs)"
by (auto dest: cat_Set_is_arrD(1))
from cf_hom_rhs_umap_fo_a show arr_Set_cf_hom_rhs_umap_fo_a:
"arr_Set β (?cf_hom_rhs ∘⇩A⇘cat_Set β⇙ ?umap_fo a)"
by (auto dest: cat_Set_is_arrD(1))
show
"(?umap_fo b ∘⇩A⇘cat_Set β⇙ ?cf_hom_lhs)⦇ArrVal⦈ =
(?cf_hom_rhs ∘⇩A⇘cat_Set β⇙ ?umap_fo a)⦇ArrVal⦈"
proof
(
rule vsv_eqI,
unfold
dom_umap_fo_cf_hom_lhs dom_cf_hom_rhs_umap_fo_a in_Hom_iff;
(rule refl)?
)
fix ℌ assume prems:
"ℌ : cf_map (?H_ℭ c) ↦⇘?FUNCT ℭ⇙ cf_map (?H_𝔄𝔊 a)"
let ?ℌ = ‹ntcf_of_ntcf_arrow ℭ (cat_Set α) ℌ›
let ?lhs = ‹?H_𝔄ε b ∙⇩N⇩T⇩C⇩F ((?H_A𝔊 f ∙⇩N⇩T⇩C⇩F ?ℌ) ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎)›
let ?rhs =
‹(?H_A f ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔗 ∙⇩N⇩T⇩C⇩F ?H_𝔄ε a ∙⇩N⇩T⇩C⇩F (?ℌ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎))›
let ?cf_hom_𝔄ε = ‹λb b'. cf_hom 𝔄 [𝔄⦇CId⦈⦇b⦈, ε⦇NTMap⦈⦇b'⦈]⇩∘›
let ?Yc = ‹λQ. Yoneda_component (?H_𝔄 b) a f Q›
let ?ℌ𝔎 = ‹λb'. ?ℌ⦇NTMap⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈›
let ?𝔊𝔎 = ‹λb'. 𝔊⦇ObjMap⦈⦇𝔎⦇ObjMap⦈⦇b'⦈⦈›
have [cat_cs_simps]:
"cf_of_cf_map ℭ (cat_Set α) (cf_map (?H_ℭ c)) = ?H_ℭ c"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
have [cat_cs_simps]:
"cf_of_cf_map ℭ (cat_Set α) (cf_map (?H_𝔄𝔊 a)) = ?H_𝔄𝔊 a"
by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)
note ℌ = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]
have Hom_c: "?H_ℭ𝔎 c : 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have [cat_cs_simps]: "?lhs = ?rhs"
proof(rule ntcf_eqI)
from ℌ(1) f show lhs:
"?lhs : ?H_ℭ𝔎 c ↦⇩C⇩F ?H_𝔄𝔗 b : 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_simp: cs_intro: cat_cs_intros)
then have dom_lhs: "𝒟⇩∘ (?lhs⦇NTMap⦈) = 𝔅⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)+
from ℌ(1) f show rhs:
"?rhs : ?H_ℭ𝔎 c ↦⇩C⇩F ?H_𝔄𝔗 b : 𝔅 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_simp: cs_intro: cat_cs_intros)
then have dom_rhs: "𝒟⇩∘ (?rhs⦇NTMap⦈) = 𝔅⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)+
have [cat_cs_simps]:
"?cf_hom_𝔄ε b b' ∘⇩A⇘cat_Set α⇙
(?Yc (?𝔊𝔎 b') ∘⇩A⇘cat_Set α⇙ ?ℌ𝔎 b') =
?Yc (𝔗⦇ObjMap⦈⦇b'⦈) ∘⇩A⇘cat_Set α⇙
(?cf_hom_𝔄ε a b' ∘⇩A⇘cat_Set α⇙ ?ℌ𝔎 b')"
(is ‹?lhs_Set = ?rhs_Set›)
if "b' ∈⇩∘ 𝔅⦇Obj⦈" for b'
proof-
let ?𝔎b' = ‹𝔎⦇ObjMap⦈⦇b'⦈›
from ℌ(1) f that assms(3) Ran.HomCod.category_axioms
have lhs_Set_is_arr: "?lhs_Set :
Hom ℭ c (?𝔎b') ↦⇘cat_Set α⇙ Hom 𝔄 b (𝔗⦇ObjMap⦈⦇b'⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro:
cat_cs_intros cat_prod_cs_intros cat_op_intros
)
then have dom_lhs_Set: "𝒟⇩∘ (?lhs_Set⦇ArrVal⦈) = Hom ℭ c ?𝔎b'"
by (cs_concl cs_simp: cat_cs_simps)
from ℌ(1) f that assms(3) Ran.HomCod.category_axioms
have rhs_Set_is_arr: "?rhs_Set :
Hom ℭ c (?𝔎b') ↦⇘cat_Set α⇙ Hom 𝔄 b (𝔗⦇ObjMap⦈⦇b'⦈)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro:
cat_cs_intros cat_prod_cs_intros cat_op_intros
)
then have dom_rhs_Set: "𝒟⇩∘ (?rhs_Set⦇ArrVal⦈) = Hom ℭ c ?𝔎b'"
by (cs_concl cs_simp: cat_cs_simps)
show ?thesis
proof(rule arr_Set_eqI)
from lhs_Set_is_arr show arr_Set_lhs_Set: "arr_Set α ?lhs_Set"
by (auto dest: cat_Set_is_arrD(1))
from rhs_Set_is_arr show arr_Set_rhs_Set: "arr_Set α ?rhs_Set"
by (auto dest: cat_Set_is_arrD(1))
show "?lhs_Set⦇ArrVal⦈ = ?rhs_Set⦇ArrVal⦈"
proof(rule vsv_eqI, unfold dom_lhs_Set dom_rhs_Set in_Hom_iff)
fix h assume "h : c ↦⇘ℭ⇙ ?𝔎b'"
with ℌ(1) f that assms Ran.HomCod.category_axioms show
"?lhs_Set⦇ArrVal⦈⦇h⦈ = ?rhs_Set⦇ArrVal⦈⦇h⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro:
cat_cs_intros cat_prod_cs_intros cat_op_intros
)
qed (use arr_Set_lhs_Set arr_Set_rhs_Set in auto)
qed
(
use lhs_Set_is_arr rhs_Set_is_arr in
‹cs_concl cs_simp: cat_cs_simps›
)+
qed
show "?lhs⦇NTMap⦈ = ?rhs⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix b' assume "b' ∈⇩∘ 𝔅⦇Obj⦈"
with ℌ(1) f assms(3) show "?lhs⦇NTMap⦈⦇b'⦈ = ?rhs⦇NTMap⦈⦇b'⦈"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_cs_intros
)
qed (cs_concl cs_intro: cat_cs_intros)
qed simp_all
from
assms(3) f ℌ(1) prems αβ
Ran.HomCod.category_axioms
FUNCT_ℭ.category_axioms
FUNCT_𝔅.category_axioms
AG.is_functor_axioms
Ran.is_functor_axioms
Hom_f.is_ntcf_axioms
show
"(?umap_fo b ∘⇩A⇘cat_Set β⇙ ?cf_hom_lhs)⦇ArrVal⦈⦇ℌ⦈ =
(?cf_hom_rhs ∘⇩A⇘cat_Set β⇙ ?umap_fo a)⦇ArrVal⦈⦇ℌ⦈"
by (subst (1 2) ℌ(2))
(
cs_concl
cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
cs_intro:
cat_cs_intros
cat_prod_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
)
qed
(
use arr_Set_umap_fo_cf_hom_lhs arr_Set_cf_hom_rhs_umap_fo_a in
auto
)
qed
(
use umap_fo_cf_hom_lhs cf_hom_rhs_umap_fo_a in
‹cs_concl cs_simp: cat_cs_simps›
)+
qed
from f assms αβ show ?thesis
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
)
qed
qed auto
qed
from L_10_5_χ_is_iso_ntcf[OF β αβ assms] have inv_χ:
"inv_ntcf (L_10_5_χ α β 𝔗 𝔎 c) :
L_10_5_N α β 𝔗 𝔎 c ↦⇩C⇩F⇩.⇩i⇩s⇩o cf_Cone α β ?𝔗_c𝔎 :
op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
by (auto intro: iso_ntcf_is_arr_isomorphism)
define φ where "φ = inv_ntcf (L_10_5_χ α β 𝔗 𝔎 c) ∙⇩N⇩T⇩C⇩F ψ ∙⇩N⇩T⇩C⇩F inv_ntcf Y'"
from inv_Y' ψ inv_χ have φ: "φ :
Hom⇩O⇩.⇩C⇘β⇙𝔄(-,?𝔊c) ↦⇩C⇩F⇩.⇩i⇩s⇩o cf_Cone α β ?𝔗_c𝔎 :
op_cat 𝔄 ↦↦⇩C⇘β⇙ cat_Set β"
unfolding φ_def by (cs_concl cs_intro: cat_cs_intros)
interpret φ: is_iso_ntcf
β ‹op_cat 𝔄› ‹cat_Set β› ‹Hom⇩O⇩.⇩C⇘β⇙𝔄(-,?𝔊c)› ‹cf_Cone α β ?𝔗_c𝔎› φ
by (rule φ)
let ?φ_𝔊c_CId = ‹φ⦇NTMap⦈⦇?𝔊c⦈⦇ArrVal⦈⦇𝔄⦇CId⦈⦇?𝔊c⦈⦈›
let ?ntcf_φ_𝔊c_CId = ‹ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 ?φ_𝔊c_CId›
from AG.vempty_is_zet assms(3) have Δ: "?Δ : 𝔄 ↦↦⇩C⇘α⇙ ?c𝔎_𝔄"
by
(
cs_concl
cs_simp: cat_comma_cs_simps
cs_intro: cat_small_cs_intros cat_cs_intros cat_comma_cs_intros
)
from assms(3) have 𝔊c: "?𝔊c ∈⇩∘ 𝔄⦇Obj⦈"
by (cs_concl cs_intro: cat_cs_intros)
from AG.vempty_is_zet have 𝔗_c𝔎: "cf_map (?𝔗_c𝔎) ∈⇩∘ ?c𝔎_𝔄⦇Obj⦈"
by
(
cs_concl
cs_simp: cat_Funct_components(1)
cs_intro: cat_small_cs_intros cat_FUNCT_cs_intros
)
from
φ.ntcf_NTMap_is_arr[unfolded cat_op_simps, OF 𝔊c]
assms(3)
AG.vempty_is_zet
β.vempty_is_zet
αβ
have φ_𝔊c: "φ⦇NTMap⦈⦇?𝔊c⦈ :
Hom 𝔄 ?𝔊c?𝔊c ↦⇘cat_Set β⇙
Hom ?c𝔎_𝔄 (cf_map (?cf_c𝔎_𝔄 ?𝔊c)) (cf_map ?𝔗_c𝔎)"
by
(
cs_prems
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
cat_comma_cs_simps
cat_op_simps
cat_Funct_components(1)
cs_intro:
cat_small_cs_intros
cat_Kan_cs_intros
cat_comma_cs_intros
cat_cs_intros
cat_FUNCT_cs_intros
cat_op_intros
category.cat_category_if_ge_Limit[where α=α and β=β]
is_functor.cf_is_functor_if_ge_Limit[where α=α and β=β]
)
with assms(3) have φ_𝔊c_CId:
"?φ_𝔊c_CId : cf_map (?cf_c𝔎_𝔄 ?𝔊c) ↦⇘?c𝔎_𝔄⇙ cf_map ?𝔗_c𝔎"
by (cs_concl cs_intro: cat_cs_intros)
have ntcf_arrow_φ_𝔊c_CId: "ntcf_arrow ?ntcf_φ_𝔊c_CId = ?φ_𝔊c_CId"
by (rule cat_Funct_is_arrD(2)[OF φ_𝔊c_CId, symmetric])
have ua: "universal_arrow_fo ?Δ (cf_map (?𝔗_c𝔎)) ?𝔊c ?φ_𝔊c_CId"
by
(
rule is_functor.cf_universal_arrow_fo_if_is_iso_ntcf_if_ge_Limit[
OF Δ β αβ 𝔊c 𝔗_c𝔎 φ[unfolded cf_Cone_def cat_cs_simps]
]
)
moreover have ntcf_φ_𝔊c_CId:
"?ntcf_φ_𝔊c_CId : ?𝔊c <⇩C⇩F⇩.⇩c⇩o⇩n⇩e ?𝔗_c𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
proof(intro is_cat_coneI)
from cat_Funct_is_arrD(1)[OF φ_𝔊c_CId] assms(3) AG.vempty_is_zet show
"ntcf_of_ntcf_arrow (c ↓⇩C⇩F 𝔎) 𝔄 ?φ_𝔊c_CId :
?cf_c𝔎_𝔄 ?𝔊c ↦⇩C⇩F⇩.⇩t⇩m ?𝔗_c𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
by
(
cs_prems
cs_simp: cat_cs_simps cat_FUNCT_cs_simps
cs_intro: cat_cs_intros cat_FUNCT_cs_intros
)
qed (rule 𝔊c)
ultimately have "?ntcf_φ_𝔊c_CId : ?𝔊c <⇩C⇩F⇩.⇩l⇩i⇩m ?𝔗_c𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by
(
intro is_cat_limitI[
where u=‹?ntcf_φ_𝔊c_CId›, unfolded ntcf_arrow_φ_𝔊c_CId
]
)
then show ?thesis using that by auto
qed
subsection‹The limit for the pointwise Kan extension›
subsubsection‹Definition and elementary properties›
text‹See Theorem 3 in Chapter X-5 in \cite{mac_lane_categories_2010}.›
definition the_pw_cat_rKe_limit :: "V ⇒ V ⇒ V ⇒ V ⇒ V ⇒ V"
where "the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊 c =
[
𝔊⦇ObjMap⦈⦇c⦈,
(
SOME UA.
UA : 𝔊⦇ObjMap⦈⦇c⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔗⦇HomCod⦈
)
]⇩∘"
text‹Components.›
lemma the_pw_cat_rKe_limit_components:
shows "the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊 c⦇UObj⦈ = 𝔊⦇ObjMap⦈⦇c⦈"
and "the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊 c⦇UArr⦈ =
(
SOME UA.
UA : 𝔊⦇ObjMap⦈⦇c⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔗⦇HomCod⦈
)"
unfolding the_pw_cat_rKe_limit_def ua_field_simps
by (simp_all add: nat_omega_simps)
context is_functor
begin
lemmas the_pw_cat_rKe_limit_components' =
the_pw_cat_rKe_limit_components[where 𝔗=𝔉, unfolded cat_cs_simps]
end
subsubsection‹The limit for the pointwise Kan extension is a limit›
lemma (in is_cat_pw_rKe) cat_pw_rKe_the_pw_cat_rKe_limit_is_limit:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
and "c ∈⇩∘ ℭ⦇Obj⦈"
shows "the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊 c⦇UArr⦈ :
the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊 c⦇UObj⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 :
c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
proof-
from cat_pw_rKe_ex_cat_limit[OF assms] obtain UA
where UA: "UA : 𝔊⦇ObjMap⦈⦇c⦈ <⇩C⇩F⇩.⇩l⇩i⇩m 𝔗 ∘⇩C⇩F c ⇩O⨅⇩C⇩F 𝔎 : c ↓⇩C⇩F 𝔎 ↦↦⇩C⇘α⇙ 𝔄"
by auto
show ?thesis
unfolding the_pw_cat_rKe_limit_components
by (rule someI2, unfold cat_cs_simps, rule UA)
qed
lemma (in is_cat_pw_rKe) cat_pw_rKe_the_ntcf_rKe_is_cat_rKe:
assumes "𝔎 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ ℭ"
and "𝔗 : 𝔅 ↦↦⇩C⇩.⇩t⇩m⇘α⇙ 𝔄"
shows "the_ntcf_rKe α 𝔗 𝔎 (the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊) :
the_cf_rKe α 𝔗 𝔎 (the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊) ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 :
𝔅 ↦⇩C ℭ ↦⇩C 𝔄"
proof-
interpret 𝔗: is_tm_functor α 𝔅 𝔄 𝔗 by (rule assms(2))
show "the_ntcf_rKe α 𝔗 𝔎 (the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊) :
the_cf_rKe α 𝔗 𝔎 (the_pw_cat_rKe_limit α 𝔎 𝔗 𝔊) ∘⇩C⇩F 𝔎 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 :
𝔅 ↦⇩C ℭ ↦⇩C 𝔄"
by
(
rule
the_ntcf_rKe_is_cat_rKe
[
OF
assms(1)
ntcf_rKe.NTCod.is_functor_axioms
cat_pw_rKe_the_pw_cat_rKe_limit_is_limit[OF assms]
]
)
qed
text‹\newpage›
end
Theory CZH_UCAT_PWKan_Example
section‹Pointwise Kan extensions: application example›
theory CZH_UCAT_PWKan_Example
imports
CZH_Elementary_Categories.CZH_ECAT_Ordinal
CZH_UCAT_PWKan
begin
subsection‹Background›
text‹
The application example presented in this section is based on
Exercise 6.1.ii in \cite{riehl_category_2016}.
›
lemma cat_ordinal_2_is_arrE:
assumes "f : a ↦⇘cat_ordinal (2⇩ℕ)⇙ b"
obtains "f = [0, 0]⇩∘" and " a = 0" and "b = 0"
| "f = [0, 1⇩ℕ]⇩∘" and "a = 0" and "b = 1⇩ℕ"
| "f = [1⇩ℕ, 1⇩ℕ]⇩∘" and "a = 1⇩ℕ" and "b = 1⇩ℕ"
using cat_ordinal_is_arrD[OF assms] unfolding two by auto
lemma cat_ordinal_3_is_arrE:
assumes "f : a ↦⇘cat_ordinal (3⇩ℕ)⇙ b"
obtains "f = [0, 0]⇩∘" and " a = 0" and "b = 0"
| "f = [0, 1⇩ℕ]⇩∘" and "a = 0" and "b = 1⇩ℕ"
| "f = [0, 2⇩ℕ]⇩∘" and "a = 0" and "b = 2⇩ℕ"
| "f = [1⇩ℕ, 1⇩ℕ]⇩∘" and "a = 1⇩ℕ" and "b = 1⇩ℕ"
| "f = [1⇩ℕ, 2⇩ℕ]⇩∘" and "a = 1⇩ℕ" and "b = 2⇩ℕ"
| "f = [2⇩ℕ, 2⇩ℕ]⇩∘" and "a = 2⇩ℕ" and "b = 2⇩ℕ"
using cat_ordinal_is_arrD[OF assms] unfolding three by auto
lemma 0123: "0 ∈⇩∘ 2⇩ℕ" "1⇩ℕ ∈⇩∘ 2⇩ℕ" "0 ∈⇩∘ 3⇩ℕ" "1⇩ℕ ∈⇩∘ 3⇩ℕ" "2⇩ℕ ∈⇩∘ 3⇩ℕ" by auto
subsection‹‹𝔎23››
subsubsection‹Definition and elementary properties›
definition 𝔎23 :: V
where "𝔎23 =
[
(λa∈⇩∘cat_ordinal (2⇩ℕ)⦇Obj⦈. if a = 0 then 0 else 2⇩ℕ),
(
λf∈⇩∘cat_ordinal (2⇩ℕ)⦇Arr⦈.
if f = [0, 0]⇩∘ ⇒ [0, 0]⇩∘
| f = [0, 1⇩ℕ]⇩∘ ⇒ [0, 2⇩ℕ]⇩∘
| f = [1⇩ℕ, 1⇩ℕ]⇩∘ ⇒ [2⇩ℕ, 2⇩ℕ]⇩∘
| otherwise ⇒ 0
),
cat_ordinal (2⇩ℕ),
cat_ordinal (3⇩ℕ)
]⇩∘"
text‹Components.›
lemma 𝔎23_components:
shows "𝔎23⦇ObjMap⦈ = (λa∈⇩∘cat_ordinal (2⇩ℕ)⦇Obj⦈. if a = 0 then 0 else 2⇩ℕ)"
and "𝔎23⦇ArrMap⦈ =
(
λf∈⇩∘cat_ordinal (2⇩ℕ)⦇Arr⦈.
if f = [0, 0]⇩∘ ⇒ [0, 0]⇩∘
| f = [0, 1⇩ℕ]⇩∘ ⇒ [0, 2⇩ℕ]⇩∘
| f = [1⇩ℕ, 1⇩ℕ]⇩∘ ⇒ [2⇩ℕ, 2⇩ℕ]⇩∘
| otherwise ⇒ 0
)"
and [cat_Kan_cs_simps]: "𝔎23⦇HomDom⦈ = cat_ordinal (2⇩ℕ)"
and [cat_Kan_cs_simps]: "𝔎23⦇HomCod⦈ = cat_ordinal (3⇩ℕ)"
unfolding 𝔎23_def dghm_field_simps by (simp_all add: nat_omega_simps)
subsubsection‹Object map›
mk_VLambda 𝔎23_components(1)
|vsv 𝔎23_ObjMap_vsv[cat_Kan_cs_intros]|
|vdomain 𝔎23_ObjMap_vdomain[cat_Kan_cs_simps]|
|app 𝔎23_ObjMap_app|
lemma 𝔎23_ObjMap_app_0[cat_Kan_cs_simps]:
assumes "x = 0"
shows "𝔎23⦇ObjMap⦈⦇x⦈ = 0"
by
(
cs_concl
cs_simp: 𝔎23_ObjMap_app cat_ordinal_cs_simps V_cs_simps assms
cs_intro: nat_omega_intros
)
lemma 𝔎23_ObjMap_app_1[cat_Kan_cs_simps]:
assumes "x = 1⇩ℕ"
shows "𝔎23⦇ObjMap⦈⦇x⦈ = 2⇩ℕ"
by
(
cs_concl
cs_simp:
cat_ordinal_cs_simps V_cs_simps omega_of_set 𝔎23_ObjMap_app assms
cs_intro: nat_omega_intros V_cs_intros
)
subsubsection‹Arrow map›
mk_VLambda 𝔎23_components(2)
|vsv 𝔎23_ArrMap_vsv[cat_Kan_cs_intros]|
|vdomain 𝔎23_ArrMap_vdomain[cat_Kan_cs_simps]|
|app 𝔎23_ArrMap_app|
lemma 𝔎23_ArrMap_app_00[cat_Kan_cs_simps]:
assumes "f = [0, 0]⇩∘"
shows "𝔎23⦇ArrMap⦈⦇f⦈ = [0, 0]⇩∘"
unfolding assms
by
(
cs_concl
cs_simp: 𝔎23_ArrMap_app cat_ordinal_cs_simps V_cs_simps
cs_intro: cat_ordinal_cs_intros nat_omega_intros
)
lemma 𝔎23_ArrMap_app_01[cat_Kan_cs_simps]:
assumes "f = [0, 1⇩ℕ]⇩∘"
shows "𝔎23⦇ArrMap⦈⦇f⦈ = [0, 2⇩ℕ]⇩∘"
proof-
have "[0, 1⇩ℕ]⇩∘ ∈⇩∘ ordinal_arrs (2⇩ℕ)"
by
(
cs_concl
cs_simp: omega_of_set
cs_intro: cat_ordinal_cs_intros V_cs_intros nat_omega_intros
)
then show ?thesis
unfolding assms by (simp add: 𝔎23_components cat_ordinal_components)
qed
lemma 𝔎23_ArrMap_app_11[cat_Kan_cs_simps]:
assumes "f = [1⇩ℕ, 1⇩ℕ]⇩∘"
shows "𝔎23⦇ArrMap⦈⦇f⦈ = [2⇩ℕ, 2⇩ℕ]⇩∘"
proof-
have "[1⇩ℕ, 1⇩ℕ]⇩∘ ∈⇩∘ ordinal_arrs (2⇩ℕ)"
by
(
cs_concl
cs_simp: omega_of_set
cs_intro: cat_ordinal_cs_intros V_cs_intros nat_omega_intros
)
then show ?thesis
unfolding assms by (simp add: 𝔎23_components cat_ordinal_components)
qed
subsubsection‹‹𝔎23› is a tiny functor›
lemma (in 𝒵) 𝔎23_is_functor: "𝔎23 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ cat_ordinal (3⇩ℕ)"
proof-
from ord_of_nat_ω interpret cat_ordinal_2: finite_category α ‹cat_ordinal (2⇩ℕ)›
by (cs_concl cs_intro: cat_ordinal_cs_intros)
from ord_of_nat_ω interpret cat_ordinal_3: finite_category α ‹cat_ordinal (3⇩ℕ)›
by (cs_concl cs_intro: cat_ordinal_cs_intros)
show ?thesis
proof(intro is_tiny_functorI' is_functorI')
show "vfsequence 𝔎23" unfolding 𝔎23_def by auto
show "vcard 𝔎23 = 4⇩ℕ" unfolding 𝔎23_def by (simp add: nat_omega_simps)
show "ℛ⇩∘ (𝔎23⦇ObjMap⦈) ⊆⇩∘ cat_ordinal (3⇩ℕ)⦇Obj⦈"
proof
(
rule vsv.vsv_vrange_vsubset,
unfold cat_Kan_cs_simps cat_ordinal_cs_simps,
intro cat_Kan_cs_intros
)
fix x assume "x ∈⇩∘ 2⇩ℕ"
then consider ‹x = 0› | ‹x = 1⇩ℕ› unfolding two by auto
then show "𝔎23⦇ObjMap⦈⦇x⦈ ∈⇩∘ 3⇩ℕ"
by (cases, use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp: cat_Kan_cs_simps omega_of_set cs_intro: nat_omega_intros
)+
qed
show "𝔎23⦇ArrMap⦈⦇f⦈ : 𝔎23⦇ObjMap⦈⦇a⦈ ↦⇘cat_ordinal (3⇩ℕ)⇙ 𝔎23⦇ObjMap⦈⦇b⦈"
if "f : a ↦⇘cat_ordinal (2⇩ℕ)⇙ b" for a b f
using that
by (elim cat_ordinal_2_is_arrE; simp only:)
(
cs_concl
cs_simp: omega_of_set cat_Kan_cs_simps
cs_intro: nat_omega_intros V_cs_intros cat_ordinal_cs_intros
)
show
"𝔎23⦇ArrMap⦈⦇g ∘⇩A⇘cat_ordinal (2⇩ℕ)⇙ f⦈ =
𝔎23⦇ArrMap⦈⦇g⦈ ∘⇩A⇘cat_ordinal (3⇩ℕ)⇙ 𝔎23⦇ArrMap⦈⦇f⦈"
if "g : b ↦⇘cat_ordinal (2⇩ℕ)⇙ c" and "f : a ↦⇘cat_ordinal (2⇩ℕ)⇙ b"
for b c g a f
proof-
have "0 ∈⇩∘ 3⇩ℕ" "1⇩ℕ ∈⇩∘ 3⇩ℕ" "2⇩ℕ ∈⇩∘ 3⇩ℕ" by auto
then show ?thesis
using that
by (elim cat_ordinal_2_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_Kan_cs_simps
cs_intro: V_cs_intros cat_ordinal_cs_intros
)+
qed
show
"𝔎23⦇ArrMap⦈⦇cat_ordinal (2⇩ℕ)⦇CId⦈⦇c⦈⦈ =
cat_ordinal (3⇩ℕ)⦇CId⦈⦇𝔎23⦇ObjMap⦈⦇c⦈⦈"
if "c ∈⇩∘ cat_ordinal (2⇩ℕ)⦇Obj⦈" for c
proof-
from that consider ‹c = 0› | ‹c = 1⇩ℕ›
unfolding cat_ordinal_components(1) two by auto
then show ?thesis
by (cases, use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp: omega_of_set cat_Kan_cs_simps cat_ordinal_cs_simps
cs_intro: nat_omega_intros cat_ordinal_cs_intros
)
qed
qed (auto intro!: cat_cs_intros simp: 𝔎23_components)
qed
lemma (in 𝒵) 𝔎23_is_functor'[cat_Kan_cs_intros]:
assumes "𝔄' = cat_ordinal (2⇩ℕ)"
and "𝔅' = cat_ordinal (3⇩ℕ)"
shows "𝔎23 : 𝔄' ↦↦⇩C⇘α⇙ 𝔅'"
unfolding assms by (rule 𝔎23_is_functor)
lemmas [cat_Kan_cs_intros] = 𝒵.𝔎23_is_functor'
lemma (in 𝒵) 𝔎23_is_tiny_functor:
"𝔎23 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇩.⇩t⇩i⇩n⇩y⇘α⇙ cat_ordinal (3⇩ℕ)"
proof-
from ord_of_nat_ω interpret cat_ordinal_2: finite_category α ‹cat_ordinal (2⇩ℕ)›
by (cs_concl cs_intro: cat_ordinal_cs_intros)
from ord_of_nat_ω interpret cat_ordinal_3: finite_category α ‹cat_ordinal (3⇩ℕ)›
by (cs_concl cs_intro: cat_ordinal_cs_intros)
show ?thesis
by (intro is_tiny_functorI' 𝔎23_is_functor)
(auto intro!: cat_small_cs_intros)
qed
lemma (in 𝒵) 𝔎23_is_tiny_functor'[cat_Kan_cs_intros]:
assumes "𝔄' = cat_ordinal (2⇩ℕ)"
and "𝔅' = cat_ordinal (3⇩ℕ)"
shows "𝔎23 : 𝔄' ↦↦⇩C⇩.⇩t⇩i⇩n⇩y⇘α⇙ 𝔅'"
unfolding assms by (rule 𝔎23_is_tiny_functor)
lemmas [cat_Kan_cs_intros] = 𝒵.𝔎23_is_tiny_functor'
subsection‹
‹LK23›: the functor associated with the left Kan extension along \<^const>‹𝔎23›
›
subsubsection‹Definition and elementary properties›
definition LK23 :: "V ⇒ V"
where "LK23 𝔉 =
[
(
λa∈⇩∘cat_ordinal (3⇩ℕ)⦇Obj⦈.
if a = 0 ⇒ 𝔉⦇ObjMap⦈⦇0⦈
| a = 1⇩ℕ ⇒ 𝔉⦇ObjMap⦈⦇0⦈
| a = 2⇩ℕ ⇒ 𝔉⦇ObjMap⦈⦇1⇩ℕ⦈
| otherwise ⇒ 𝔉⦇HomCod⦈⦇Obj⦈
),
(
λf∈⇩∘cat_ordinal (3⇩ℕ)⦇Arr⦈.
if f = [0, 0]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈⇩∙
| f = [0, 1⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈⇩∙
| f = [0, 2⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙
| f = [1⇩ℕ, 1⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈⇩∙
| f = [1⇩ℕ, 2⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙
| f = [2⇩ℕ, 2⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙
| otherwise ⇒ 𝔉⦇HomCod⦈⦇Arr⦈
),
cat_ordinal (3⇩ℕ),
𝔉⦇HomCod⦈
]⇩∘"
text‹Components.›
lemma LK23_components:
shows "LK23 𝔉⦇ObjMap⦈ =
(
λa∈⇩∘cat_ordinal (3⇩ℕ)⦇Obj⦈.
if a = 0 ⇒ 𝔉⦇ObjMap⦈⦇0⦈
| a = 1⇩ℕ ⇒ 𝔉⦇ObjMap⦈⦇0⦈
| a = 2⇩ℕ ⇒ 𝔉⦇ObjMap⦈⦇1⇩ℕ⦈
| otherwise ⇒ 𝔉⦇HomCod⦈⦇Obj⦈
)"
and "LK23 𝔉⦇ArrMap⦈ =
(
λf∈⇩∘cat_ordinal (3⇩ℕ)⦇Arr⦈.
if f = [0, 0]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈⇩∙
| f = [0, 1⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈⇩∙
| f = [0, 2⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙
| f = [1⇩ℕ, 1⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈⇩∙
| f = [1⇩ℕ, 2⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙
| f = [2⇩ℕ, 2⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙
| otherwise ⇒ 𝔉⦇HomCod⦈⦇Arr⦈
)"
and "LK23 𝔉⦇HomDom⦈ = cat_ordinal (3⇩ℕ)"
and "LK23 𝔉⦇HomCod⦈ = 𝔉⦇HomCod⦈"
unfolding LK23_def dghm_field_simps by (simp_all add: nat_omega_simps)
context is_functor
begin
lemmas LK23_components' = LK23_components[where 𝔉=𝔉, unfolded cat_cs_simps]
lemmas [cat_Kan_cs_simps] = LK23_components'(3,4)
end
lemmas [cat_Kan_cs_simps] = is_functor.LK23_components'(3,4)
subsubsection‹Object map›
mk_VLambda LK23_components(1)
|vsv LK23_ObjMap_vsv[cat_Kan_cs_intros]|
|vdomain LK23_ObjMap_vdomain[cat_Kan_cs_simps]|
|app LK23_ObjMap_app|
lemma LK23_ObjMap_app_0[cat_Kan_cs_simps]:
assumes "a = 0"
shows "LK23 𝔉⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇0⦈"
unfolding LK23_components assms cat_ordinal_components by simp
lemma LK23_ObjMap_app_1[cat_Kan_cs_simps]:
assumes "a = 1⇩ℕ"
shows "LK23 𝔉⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇0⦈"
unfolding LK23_components assms cat_ordinal_components by simp
lemma LK23_ObjMap_app_2[cat_Kan_cs_simps]:
assumes "a = 2⇩ℕ"
shows "LK23 𝔉⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇1⇩ℕ⦈"
unfolding LK23_components assms cat_ordinal_components by simp
subsubsection‹Arrow map›
mk_VLambda LK23_components(2)
|vsv LK23_ArrMap_vsv[cat_Kan_cs_intros]|
|vdomain LK23_ArrMap_vdomain[cat_Kan_cs_simps]|
|app LK23_ArrMap_app|
lemma LK23_ArrMap_app_00[cat_Kan_cs_simps]:
assumes "f = [0, 0]⇩∘"
shows "LK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 0⦈⇩∙"
proof-
from 0123 have f: "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding LK23_components assms by auto
qed
lemma LK23_ArrMap_app_01[cat_Kan_cs_simps]:
assumes "f = [0, 1⇩ℕ]⇩∘"
shows "LK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 0⦈⇩∙"
proof-
from 0123 have f: "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding LK23_components assms by auto
qed
lemma LK23_ArrMap_app_02[cat_Kan_cs_simps]:
assumes "f = [0, 2⇩ℕ]⇩∘"
shows "LK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙"
proof-
from 0123 have f: "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding LK23_components assms by auto
qed
lemma LK23_ArrMap_app_11[cat_Kan_cs_simps]:
assumes "f = [1⇩ℕ, 1⇩ℕ]⇩∘"
shows "LK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 0⦈⇩∙"
proof-
from 0123 have f: "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding LK23_components assms by auto
qed
lemma LK23_ArrMap_app_12[cat_Kan_cs_simps]:
assumes "f = [1⇩ℕ, 2⇩ℕ]⇩∘"
shows "LK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙"
proof-
from 0123 have f: "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl
cs_simp: omega_of_set
cs_intro: nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding LK23_components assms by auto
qed
lemma LK23_ArrMap_app_22[cat_Kan_cs_simps]:
assumes "f = [2⇩ℕ, 2⇩ℕ]⇩∘"
shows "LK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙"
proof-
from 0123 have f: "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl cs_simp: cs_intro:
nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding LK23_components assms by simp
qed
subsubsection‹‹LK23› is a functor›
lemma cat_LK23_is_functor:
assumes "𝔉 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ ℭ"
shows "LK23 𝔉 : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ ℭ"
proof-
interpret 𝔉: is_functor α ‹cat_ordinal (2⇩ℕ)› ℭ 𝔉 by (rule assms(1))
from ord_of_nat_ω interpret cat_ordinal_2: finite_category α ‹cat_ordinal (2⇩ℕ)›
by (cs_concl cs_intro: cat_ordinal_cs_intros)
from ord_of_nat_ω interpret cat_ordinal_3: finite_category α ‹cat_ordinal (3⇩ℕ)›
by (cs_concl cs_intro: cat_ordinal_cs_intros)
interpret 𝔉: is_functor α ‹cat_ordinal (2⇩ℕ)› ℭ 𝔉 by (rule assms)
show ?thesis
proof(intro is_functorI')
show "vfsequence (LK23 𝔉)" unfolding LK23_def by auto
show "vcard (LK23 𝔉) = 4⇩ℕ" unfolding LK23_def by (simp add: nat_omega_simps)
show "ℛ⇩∘ (LK23 𝔉⦇ObjMap⦈) ⊆⇩∘ ℭ⦇Obj⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_Kan_cs_simps)
fix x assume prems: "x ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Obj⦈"
then consider ‹x = 0› | ‹x = 1⇩ℕ› | ‹x = 2⇩ℕ›
unfolding cat_ordinal_cs_simps three by auto
then show "LK23 𝔉⦇ObjMap⦈⦇x⦈ ∈⇩∘ ℭ⦇Obj⦈"
by cases
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_ordinal_cs_simps omega_of_set
cs_intro: cat_cs_intros nat_omega_intros
)+
qed (cs_concl cs_intro: cat_Kan_cs_intros)
show "LK23 𝔉⦇ArrMap⦈⦇f⦈ : LK23 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ LK23 𝔉⦇ObjMap⦈⦇b⦈"
if "f : a ↦⇘cat_ordinal (3⇩ℕ)⇙ b" for a b f
proof-
from 0123 that show ?thesis
by (elim cat_ordinal_3_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
)+
qed
show
"LK23 𝔉⦇ArrMap⦈⦇g ∘⇩A⇘cat_ordinal (3⇩ℕ)⇙ f⦈ =
LK23 𝔉⦇ArrMap⦈⦇g⦈ ∘⇩A⇘ℭ⇙ LK23 𝔉⦇ArrMap⦈⦇f⦈"
if "g : b ↦⇘cat_ordinal (3⇩ℕ)⇙ c" and "f : a ↦⇘cat_ordinal (3⇩ℕ)⇙ b"
for b c g a f
proof-
from 0123 that show ?thesis
by (elim cat_ordinal_3_is_arrE; simp only:; (solves‹simp›)?)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
𝔉.cf_ArrMap_Comp[symmetric]
cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
)+
qed
show "LK23 𝔉⦇ArrMap⦈⦇cat_ordinal (3⇩ℕ)⦇CId⦈⦇c⦈⦈ = ℭ⦇CId⦈⦇LK23 𝔉⦇ObjMap⦈⦇c⦈⦈"
if "c ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Obj⦈" for c
proof-
from that consider ‹c = 0› | ‹c = 1⇩ℕ› | ‹c = 2⇩ℕ›
unfolding cat_ordinal_components three by auto
moreover have "0 ∈⇩∘ 2⇩ℕ" "1⇩ℕ ∈⇩∘ 2⇩ℕ" "0 ∈⇩∘ 3⇩ℕ" "1⇩ℕ ∈⇩∘ 3⇩ℕ" "2⇩ℕ ∈⇩∘ 3⇩ℕ" by auto
ultimately show ?thesis
by (cases, use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
is_functor.cf_ObjMap_CId[symmetric]
cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
)+
qed
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
lemma cat_LK23_is_functor'[cat_Kan_cs_intros]:
assumes "𝔉 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ ℭ"
and "𝔄' = cat_ordinal (3⇩ℕ)"
shows "LK23 𝔉 : 𝔄' ↦↦⇩C⇘α⇙ ℭ"
using assms(1) unfolding assms(2) by (rule cat_LK23_is_functor)
subsubsection‹The fundamental property of ‹LK23››
lemma cf_comp_LK23_𝔎23[cat_Kan_cs_simps]:
assumes "𝔉 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ ℭ"
shows "LK23 𝔉 ∘⇩C⇩F 𝔎23 = 𝔉"
proof-
interpret 𝔉: is_functor α ‹cat_ordinal (2⇩ℕ)› ℭ 𝔉 by (rule assms(1))
interpret 𝔎23: is_functor α ‹cat_ordinal (2⇩ℕ)› ‹cat_ordinal (3⇩ℕ)› ‹𝔎23›
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
interpret LK23: is_functor α ‹cat_ordinal (3⇩ℕ)› ℭ ‹LK23 𝔉›
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
show ?thesis
proof(rule cf_eqI)
show "𝔉 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ ℭ" by (rule assms)
have ObjMap_dom_lhs: "𝒟⇩∘ ((LK23 𝔉 ∘⇩C⇩F 𝔎23)⦇ObjMap⦈) = 2⇩ℕ"
by
(
cs_concl
cs_simp: cat_cs_simps cat_ordinal_cs_simps cs_intro: cat_cs_intros
)
have ObjMap_dom_rhs: "𝒟⇩∘ (𝔉⦇ObjMap⦈) = 2⇩ℕ"
by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
show "(LK23 𝔉 ∘⇩C⇩F 𝔎23)⦇ObjMap⦈ = 𝔉⦇ObjMap⦈"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix a assume prems: "a ∈⇩∘ 2⇩ℕ"
then consider ‹a = 0› | ‹a = 1⇩ℕ› by force
then show "(LK23 𝔉 ∘⇩C⇩F 𝔎23)⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇a⦈"
by (cases, use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp:
omega_of_set cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros nat_omega_intros
)+
qed (cs_concl cs_simp: cs_intro: cat_cs_intros V_cs_intros)+
have ArrMap_dom_lhs: "𝒟⇩∘ ((LK23 𝔉 ∘⇩C⇩F 𝔎23)⦇ArrMap⦈) = cat_ordinal (2⇩ℕ)⦇Arr⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have ArrMap_dom_rhs: "𝒟⇩∘ (𝔉⦇ArrMap⦈) = cat_ordinal (2⇩ℕ)⦇Arr⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "(LK23 𝔉 ∘⇩C⇩F 𝔎23)⦇ArrMap⦈ = 𝔉⦇ArrMap⦈"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix f assume prems: "f ∈⇩∘ cat_ordinal (2⇩ℕ)⦇Arr⦈"
then obtain a b where "f : a ↦⇘cat_ordinal (2⇩ℕ)⇙ b" by auto
then show "(LK23 𝔉 ∘⇩C⇩F 𝔎23)⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇f⦈"
by (elim cat_ordinal_2_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
)+
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)+
qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
qed
subsection‹
‹RK23›: the functor associated with the right Kan extension along \<^const>‹𝔎23›
›
subsubsection‹Definition and elementary properties›
definition RK23 :: "V ⇒ V"
where "RK23 𝔉 =
[
(
λa∈⇩∘cat_ordinal (3⇩ℕ)⦇Obj⦈.
if a = 0 ⇒ 𝔉⦇ObjMap⦈⦇0⦈
| a = 1⇩ℕ ⇒ 𝔉⦇ObjMap⦈⦇1⇩ℕ⦈
| a = 2⇩ℕ ⇒ 𝔉⦇ObjMap⦈⦇1⇩ℕ⦈
| otherwise ⇒ 𝔉⦇HomCod⦈⦇Obj⦈
),
(
λf∈⇩∘cat_ordinal (3⇩ℕ)⦇Arr⦈.
if f = [0, 0]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈⇩∙
| f = [0, 1⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙
| f = [0, 2⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙
| f = [1⇩ℕ, 1⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙
| f = [1⇩ℕ, 2⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙
| f = [2⇩ℕ, 2⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙
| otherwise ⇒ 𝔉⦇HomCod⦈⦇Arr⦈
),
cat_ordinal (3⇩ℕ),
𝔉⦇HomCod⦈
]⇩∘"
text‹Components.›
lemma RK23_components:
shows "RK23 𝔉⦇ObjMap⦈ =
(
λa∈⇩∘cat_ordinal (3⇩ℕ)⦇Obj⦈.
if a = 0 ⇒ 𝔉⦇ObjMap⦈⦇0⦈
| a = 1⇩ℕ ⇒ 𝔉⦇ObjMap⦈⦇1⇩ℕ⦈
| a = 2⇩ℕ ⇒ 𝔉⦇ObjMap⦈⦇1⇩ℕ⦈
| otherwise ⇒ 𝔉⦇HomCod⦈⦇Obj⦈
)"
and "RK23 𝔉⦇ArrMap⦈ =
(
λf∈⇩∘cat_ordinal (3⇩ℕ)⦇Arr⦈.
if f = [0, 0]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 0⦈⇩∙
| f = [0, 1⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙
| f = [0, 2⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙
| f = [1⇩ℕ, 1⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙
| f = [1⇩ℕ, 2⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙
| f = [2⇩ℕ, 2⇩ℕ]⇩∘ ⇒ 𝔉⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙
| otherwise ⇒ 𝔉⦇HomCod⦈⦇Arr⦈
)"
and "RK23 𝔉⦇HomDom⦈ = cat_ordinal (3⇩ℕ)"
and "RK23 𝔉⦇HomCod⦈ = 𝔉⦇HomCod⦈"
unfolding RK23_def dghm_field_simps by (simp_all add: nat_omega_simps)
context is_functor
begin
lemmas RK23_components' = RK23_components[where 𝔉=𝔉, unfolded cat_cs_simps]
lemmas [cat_Kan_cs_simps] = RK23_components'(3,4)
end
lemmas [cat_Kan_cs_simps] = is_functor.RK23_components'(3,4)
subsubsection‹Object map›
mk_VLambda RK23_components(1)
|vsv RK23_ObjMap_vsv[cat_Kan_cs_intros]|
|vdomain RK23_ObjMap_vdomain[cat_Kan_cs_simps]|
|app RK23_ObjMap_app|
lemma RK23_ObjMap_app_0[cat_Kan_cs_simps]:
assumes "a = 0"
shows "RK23 𝔉⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇0⦈"
unfolding RK23_components assms cat_ordinal_components by simp
lemma RK23_ObjMap_app_1[cat_Kan_cs_simps]:
assumes "a = 1⇩ℕ"
shows "RK23 𝔉⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇1⇩ℕ⦈"
unfolding RK23_components assms cat_ordinal_components by simp
lemma RK23_ObjMap_app_2[cat_Kan_cs_simps]:
assumes "a = 2⇩ℕ"
shows "RK23 𝔉⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇1⇩ℕ⦈"
unfolding RK23_components assms cat_ordinal_components by simp
subsubsection‹Arrow map›
mk_VLambda RK23_components(2)
|vsv RK23_ArrMap_vsv[cat_Kan_cs_intros]|
|vdomain RK23_ArrMap_vdomain[cat_Kan_cs_simps]|
|app RK23_ArrMap_app|
lemma RK23_ArrMap_app_00[cat_Kan_cs_simps]:
assumes "f = [0, 0]⇩∘"
shows "RK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 0⦈⇩∙"
proof-
from 0123 have f: "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding RK23_components assms by auto
qed
lemma RK23_ArrMap_app_01[cat_Kan_cs_simps]:
assumes "f = [0, 1⇩ℕ]⇩∘"
shows "RK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙"
proof-
from 0123 have f: "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding RK23_components assms by auto
qed
lemma RK23_ArrMap_app_02[cat_Kan_cs_simps]:
assumes "f = [0, 2⇩ℕ]⇩∘"
shows "RK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙"
proof-
from 0123 have f: "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding RK23_components assms by auto
qed
lemma RK23_ArrMap_app_11[cat_Kan_cs_simps]:
assumes "f = [1⇩ℕ, 1⇩ℕ]⇩∘"
shows "RK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙"
proof-
from 0123 have f: "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl cs_simp: cs_intro:
V_cs_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding RK23_components assms by auto
qed
lemma RK23_ArrMap_app_12[cat_Kan_cs_simps]:
assumes "f = [1⇩ℕ, 2⇩ℕ]⇩∘"
shows "RK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙"
proof-
from 0123 have f: "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl
cs_simp: omega_of_set
cs_intro: nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding RK23_components assms by auto
qed
lemma RK23_ArrMap_app_22[cat_Kan_cs_simps]:
assumes "f = [2⇩ℕ, 2⇩ℕ]⇩∘"
shows "RK23 𝔉⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙"
proof-
from 0123 have f: "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl cs_simp: cs_intro:
nat_omega_intros cat_ordinal_cs_intros cat_cs_intros assms
)
then show ?thesis unfolding RK23_components assms by simp
qed
subsubsection‹‹RK23› is a functor›
lemma cat_RK23_is_functor:
assumes "𝔉 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ ℭ"
shows "RK23 𝔉 : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ ℭ"
proof-
interpret 𝔉: is_functor α ‹cat_ordinal (2⇩ℕ)› ℭ 𝔉 by (rule assms(1))
from ord_of_nat_ω interpret cat_ordinal_2: finite_category α ‹cat_ordinal (2⇩ℕ)›
by (cs_concl cs_intro: cat_ordinal_cs_intros)
from ord_of_nat_ω interpret cat_ordinal_3: finite_category α ‹cat_ordinal (3⇩ℕ)›
by (cs_concl cs_intro: cat_ordinal_cs_intros)
interpret 𝔉: is_functor α ‹cat_ordinal (2⇩ℕ)› ℭ 𝔉 by (rule assms)
show ?thesis
proof(intro is_functorI')
show "vfsequence (RK23 𝔉)" unfolding RK23_def by auto
show "vcard (RK23 𝔉) = 4⇩ℕ" unfolding RK23_def by (simp add: nat_omega_simps)
show "ℛ⇩∘ (RK23 𝔉⦇ObjMap⦈) ⊆⇩∘ ℭ⦇Obj⦈"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_Kan_cs_simps)
fix x assume prems: "x ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Obj⦈"
then consider ‹x = 0› | ‹x = 1⇩ℕ› | ‹x = 2⇩ℕ›
unfolding cat_ordinal_cs_simps three by auto
then show "RK23 𝔉⦇ObjMap⦈⦇x⦈ ∈⇩∘ ℭ⦇Obj⦈"
by cases
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_ordinal_cs_simps omega_of_set
cs_intro: cat_cs_intros nat_omega_intros
)+
qed (cs_concl cs_intro: cat_Kan_cs_intros)
show "RK23 𝔉⦇ArrMap⦈⦇f⦈ : RK23 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ RK23 𝔉⦇ObjMap⦈⦇b⦈"
if "f : a ↦⇘cat_ordinal (3⇩ℕ)⇙ b" for a b f
proof-
from 0123 that show ?thesis
by (elim cat_ordinal_3_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
)+
qed
show
"RK23 𝔉⦇ArrMap⦈⦇g ∘⇩A⇘cat_ordinal (3⇩ℕ)⇙ f⦈ =
RK23 𝔉⦇ArrMap⦈⦇g⦈ ∘⇩A⇘ℭ⇙ RK23 𝔉⦇ArrMap⦈⦇f⦈"
if "g : b ↦⇘cat_ordinal (3⇩ℕ)⇙ c" and "f : a ↦⇘cat_ordinal (3⇩ℕ)⇙ b"
for b c g a f
using 0123 that
by (elim cat_ordinal_3_is_arrE; simp only:; (solves‹simp›)?)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
𝔉.cf_ArrMap_Comp[symmetric]
cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
)+
show "RK23 𝔉⦇ArrMap⦈⦇cat_ordinal (3⇩ℕ)⦇CId⦈⦇c⦈⦈ = ℭ⦇CId⦈⦇RK23 𝔉⦇ObjMap⦈⦇c⦈⦈"
if "c ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Obj⦈" for c
proof-
from that consider ‹c = 0› | ‹c = 1⇩ℕ› | ‹c = 2⇩ℕ›
unfolding cat_ordinal_components three by auto
then show ?thesis
by (cases, use 0123 in ‹simp_all only:›)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
is_functor.cf_ObjMap_CId[symmetric]
cs_intro: V_cs_intros cat_cs_intros cat_ordinal_cs_intros
)+
qed
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
lemma cat_RK23_is_functor'[cat_Kan_cs_intros]:
assumes "𝔉 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ ℭ"
and "𝔄' = cat_ordinal (3⇩ℕ)"
shows "RK23 𝔉 : 𝔄' ↦↦⇩C⇘α⇙ ℭ"
using assms(1) unfolding assms(2) by (rule cat_RK23_is_functor)
subsubsection‹The fundamental property of ‹RK23››
lemma cf_comp_RK23_𝔎23[cat_Kan_cs_simps]:
assumes "𝔉 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ ℭ"
shows "RK23 𝔉 ∘⇩C⇩F 𝔎23 = 𝔉"
proof-
interpret 𝔉: is_functor α ‹cat_ordinal (2⇩ℕ)› ℭ 𝔉 by (rule assms(1))
interpret 𝔎23: is_functor α ‹cat_ordinal (2⇩ℕ)› ‹cat_ordinal (3⇩ℕ)› ‹𝔎23›
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
interpret RK23: is_functor α ‹cat_ordinal (3⇩ℕ)› ℭ ‹RK23 𝔉›
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
show ?thesis
proof(rule cf_eqI)
show "𝔉 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ ℭ" by (rule assms)
have ObjMap_dom_lhs: "𝒟⇩∘ ((RK23 𝔉 ∘⇩C⇩F 𝔎23)⦇ObjMap⦈) = 2⇩ℕ"
by
(
cs_concl
cs_simp: cat_cs_simps cat_ordinal_cs_simps cs_intro: cat_cs_intros
)
have ObjMap_dom_rhs: "𝒟⇩∘ (𝔉⦇ObjMap⦈) = 2⇩ℕ"
by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
show "(RK23 𝔉 ∘⇩C⇩F 𝔎23)⦇ObjMap⦈ = 𝔉⦇ObjMap⦈"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix a assume prems: "a ∈⇩∘ 2⇩ℕ"
then consider ‹a = 0› | ‹a = 1⇩ℕ› by force
then show "(RK23 𝔉 ∘⇩C⇩F 𝔎23)⦇ObjMap⦈⦇a⦈ = 𝔉⦇ObjMap⦈⦇a⦈"
by (cases, use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp:
omega_of_set cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros nat_omega_intros
)+
qed (cs_concl cs_simp: cs_intro: cat_cs_intros V_cs_intros)+
have ArrMap_dom_lhs: "𝒟⇩∘ ((RK23 𝔉 ∘⇩C⇩F 𝔎23)⦇ArrMap⦈) = cat_ordinal (2⇩ℕ)⦇Arr⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
have ArrMap_dom_rhs: "𝒟⇩∘ (𝔉⦇ArrMap⦈) = cat_ordinal (2⇩ℕ)⦇Arr⦈"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "(RK23 𝔉 ∘⇩C⇩F 𝔎23)⦇ArrMap⦈ = 𝔉⦇ArrMap⦈"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix f assume prems: "f ∈⇩∘ cat_ordinal (2⇩ℕ)⦇Arr⦈"
then obtain a b where "f : a ↦⇘cat_ordinal (2⇩ℕ)⇙ b" by auto
then show "(RK23 𝔉 ∘⇩C⇩F 𝔎23)⦇ArrMap⦈⦇f⦈ = 𝔉⦇ArrMap⦈⦇f⦈"
by (elim cat_ordinal_2_is_arrE; simp only:)
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cs_intro: cat_cs_intros
)+
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros V_cs_intros)+
qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
qed
subsection‹
‹RK_σ23›: towards the universal property of the right Kan extension along ‹𝔎23›
›
subsubsection‹Definition and elementary properties›
definition RK_σ23 :: "V ⇒ V ⇒ V ⇒ V"
where "RK_σ23 𝔗 ε' 𝔉' =
[
(
λa∈⇩∘cat_ordinal (3⇩ℕ)⦇Obj⦈.
if a = 0 ⇒ ε'⦇NTMap⦈⦇0⦈
| a = 1⇩ℕ ⇒ ε'⦇NTMap⦈⦇1⇩ℕ⦈ ∘⇩A⇘𝔗⦇HomCod⦈⇙ 𝔉'⦇ArrMap⦈⦇1⇩ℕ, 2⇩ℕ⦈⇩∙
| a = 2⇩ℕ ⇒ ε'⦇NTMap⦈⦇1⇩ℕ⦈
| otherwise ⇒ 𝔗⦇HomCod⦈⦇Arr⦈
),
𝔉',
RK23 𝔗,
cat_ordinal (3⇩ℕ),
𝔉'⦇HomCod⦈
]⇩∘"
text‹Components.›
lemma RK_σ23_components:
shows "RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈ =
(
λa∈⇩∘cat_ordinal (3⇩ℕ)⦇Obj⦈.
if a = 0 ⇒ ε'⦇NTMap⦈⦇0⦈
| a = 1⇩ℕ ⇒ ε'⦇NTMap⦈⦇1⇩ℕ⦈ ∘⇩A⇘𝔗⦇HomCod⦈⇙ 𝔉'⦇ArrMap⦈⦇1⇩ℕ, 2⇩ℕ⦈⇩∙
| a = 2⇩ℕ ⇒ ε'⦇NTMap⦈⦇1⇩ℕ⦈
| otherwise ⇒ 𝔗⦇HomCod⦈⦇Arr⦈
)"
and "RK_σ23 𝔗 ε' 𝔉'⦇NTDom⦈ = 𝔉'"
and "RK_σ23 𝔗 ε' 𝔉'⦇NTCod⦈ = RK23 𝔗"
and "RK_σ23 𝔗 ε' 𝔉'⦇NTDGDom⦈ = cat_ordinal (3⇩ℕ)"
and "RK_σ23 𝔗 ε' 𝔉'⦇NTDGCod⦈ = 𝔉'⦇HomCod⦈"
unfolding RK_σ23_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes α 𝔄 𝔉' 𝔗
assumes 𝔉': "𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
and 𝔗: "𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
begin
interpretation 𝔉': is_functor α ‹cat_ordinal (3⇩ℕ)› 𝔄 𝔉' by (rule 𝔉')
interpretation 𝔗: is_functor α ‹cat_ordinal (2⇩ℕ)› 𝔄 𝔗 by (rule 𝔗)
lemmas RK_σ23_components' =
RK_σ23_components[where 𝔉'=𝔉' and 𝔗=𝔗, unfolded cat_cs_simps]
lemmas [cat_Kan_cs_simps] = RK_σ23_components'(2-5)
end
subsubsection‹Natural transformation map›
mk_VLambda RK_σ23_components(1)
|vsv RK_σ23_NTMap_vsv[cat_Kan_cs_intros]|
|vdomain RK_σ23_NTMap_vdomain[cat_Kan_cs_simps]|
|app RK_σ23_NTMap_app|
lemma RK_σ23_NTMap_app_0[cat_Kan_cs_simps]:
assumes "a = 0"
shows "RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈⦇a⦈ = ε'⦇NTMap⦈⦇0⦈"
using assms unfolding RK_σ23_components cat_ordinal_cs_simps by simp
lemma (in is_functor) RK_σ23_NTMap_app_1[cat_Kan_cs_simps]:
assumes "a = 1⇩ℕ"
shows "RK_σ23 𝔉 ε' 𝔉'⦇NTMap⦈⦇a⦈ = ε'⦇NTMap⦈⦇1⇩ℕ⦈ ∘⇩A⇘𝔅⇙ 𝔉'⦇ArrMap⦈⦇1⇩ℕ, 2⇩ℕ⦈⇩∙"
using assms
unfolding RK_σ23_components cat_ordinal_cs_simps cat_cs_simps
by simp
lemmas [cat_Kan_cs_simps] = is_functor.RK_σ23_NTMap_app_1
lemma RK_σ23_NTMap_app_2[cat_Kan_cs_simps]:
assumes "a = 2⇩ℕ"
shows "RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈⦇a⦈ = ε'⦇NTMap⦈⦇1⇩ℕ⦈"
using assms unfolding RK_σ23_components cat_ordinal_cs_simps by simp
subsubsection‹‹RK_σ23› is a natural transformation›
lemma RK_σ23_is_ntcf:
assumes "𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
and "𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
and "ε' : 𝔉' ∘⇩C⇩F 𝔎23 ↦⇩C⇩F 𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
shows "RK_σ23 𝔗 ε' 𝔉' : 𝔉' ↦⇩C⇩F RK23 𝔗 : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
proof-
interpret 𝔉': is_functor α ‹cat_ordinal (3⇩ℕ)› 𝔄 𝔉' by (rule assms(1))
interpret 𝔗: is_functor α ‹cat_ordinal (2⇩ℕ)› 𝔄 𝔗 by (rule assms(2))
interpret ε': is_ntcf α ‹cat_ordinal (2⇩ℕ)› 𝔄 ‹𝔉' ∘⇩C⇩F 𝔎23› 𝔗 ε'
by (rule assms(3))
interpret 𝔎23: is_functor α ‹cat_ordinal (2⇩ℕ)› ‹cat_ordinal (3⇩ℕ)› ‹𝔎23›
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
interpret RK23: is_functor α ‹cat_ordinal (3⇩ℕ)› 𝔄 ‹RK23 𝔗›
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
from 0123 have [cat_cs_simps]: "𝔗⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙ = 𝔄⦇CId⦈⦇𝔗⦇ObjMap⦈⦇1⇩ℕ⦈⦈"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps is_functor.cf_ObjMap_CId[symmetric]
cs_intro: cat_cs_intros
)
show ?thesis
proof(rule is_ntcfI')
show "vfsequence (RK_σ23 𝔗 ε' 𝔉')" unfolding RK_σ23_def by simp
show "vcard (RK_σ23 𝔗 ε' 𝔉') = 5⇩ℕ"
unfolding RK_σ23_def by (simp_all add: nat_omega_simps)
show "RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈⦇a⦈ : 𝔉'⦇ObjMap⦈⦇a⦈ ↦⇘𝔄⇙ RK23 𝔗⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Obj⦈" for a
proof-
from that consider ‹a = 0› | ‹a = 1⇩ℕ› | ‹a = 2⇩ℕ›
unfolding cat_ordinal_cs_simps three by auto
from this 0123 show ?thesis
by (cases, use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp: cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
cs_intro:
cat_cs_intros
cat_ordinal_cs_intros
cat_Kan_cs_intros
nat_omega_intros
)+
qed
show
"RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ 𝔉'⦇ArrMap⦈⦇f⦈ =
RK23 𝔗⦇ArrMap⦈⦇f⦈ ∘⇩A⇘𝔄⇙ RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈⦇a⦈"
if "f : a ↦⇘cat_ordinal (3⇩ℕ)⇙ b" for a b f
using that 0123
by (elim cat_ordinal_3_is_arrE, use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp:
cat_cs_simps
cat_ordinal_cs_simps
𝔉'.cf_ArrMap_Comp[symmetric]
𝔉'.HomCod.cat_Comp_assoc
ε'.ntcf_Comp_commute[symmetric]
cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
)+
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
lemma RK_σ23_is_ntcf'[cat_Kan_cs_intros]:
assumes "𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
and "𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
and "ε' : 𝔉' ∘⇩C⇩F 𝔎23 ↦⇩C⇩F 𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
and "𝔊' = 𝔉'"
and "ℌ' = RK23 𝔗"
and "ℭ' = cat_ordinal (3⇩ℕ)"
shows "RK_σ23 𝔗 ε' 𝔉' : 𝔊' ↦⇩C⇩F ℌ': ℭ' ↦↦⇩C⇘α⇙ 𝔄"
using assms(1-3) unfolding assms(4-6) by (rule RK_σ23_is_ntcf)
subsection‹The right Kan extension along ‹𝔎23››
lemma ε23_is_cat_rKe:
assumes "𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
shows "ntcf_id 𝔗 :
RK23 𝔗 ∘⇩C⇩F 𝔎23 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 : cat_ordinal (2⇩ℕ) ↦⇩C cat_ordinal (3⇩ℕ) ↦⇩C 𝔄"
proof-
interpret 𝔗: is_functor α ‹cat_ordinal (2⇩ℕ)› 𝔄 𝔗 by (rule assms(1))
interpret 𝔎23: is_functor α ‹cat_ordinal (2⇩ℕ)› ‹cat_ordinal (3⇩ℕ)› ‹𝔎23›
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
interpret RK23: is_functor α ‹cat_ordinal (3⇩ℕ)› 𝔄 ‹RK23 𝔗›
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
from 0123 have [cat_cs_simps]: "𝔗⦇ArrMap⦈⦇1⇩ℕ, 1⇩ℕ⦈⇩∙ = 𝔄⦇CId⦈⦇𝔗⦇ObjMap⦈⦇1⇩ℕ⦈⦈"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps is_functor.cf_ObjMap_CId[symmetric]
cs_intro: cat_cs_intros
)
show ?thesis
proof(intro is_cat_rKeI')
fix 𝔉' ε' assume prems:
"𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
"ε' : 𝔉' ∘⇩C⇩F 𝔎23 ↦⇩C⇩F 𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
interpret 𝔉': is_functor α ‹cat_ordinal (3⇩ℕ)› 𝔄 𝔉' by (rule prems(1))
interpret ε': is_ntcf α ‹cat_ordinal (2⇩ℕ)› 𝔄 ‹𝔉' ∘⇩C⇩F 𝔎23› 𝔗 ε'
by (rule prems(2))
interpret RK_σ23: is_ntcf α ‹cat_ordinal (3⇩ℕ)› 𝔄 𝔉' ‹RK23 𝔗› ‹RK_σ23 𝔗 ε' 𝔉'›
by (intro RK_σ23_is_ntcf prems assms)
show "∃!σ.
σ : 𝔉' ↦⇩C⇩F RK23 𝔗 : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄 ∧
ε' = ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23)"
proof(intro ex1I conjI; (elim conjE)?)
show "RK_σ23 𝔗 ε' 𝔉' : 𝔉' ↦⇩C⇩F RK23 𝔗 : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
by (intro RK_σ23.is_ntcf_axioms)
show "ε' = ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F (RK_σ23 𝔗 ε' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23)"
proof(rule ntcf_eqI)
show "ε' : 𝔉' ∘⇩C⇩F 𝔎23 ↦⇩C⇩F 𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
by (intro prems)
then have dom_lhs: "𝒟⇩∘ (ε'⦇NTMap⦈) = 2⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show rhs:
"ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F (RK_σ23 𝔗 ε' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23) :
𝔉' ∘⇩C⇩F 𝔎23 ↦⇩C⇩F 𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
then have dom_rhs:
"𝒟⇩∘ ((ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F (RK_σ23 𝔗 ε' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23))⦇NTMap⦈) = 2⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show "ε'⦇NTMap⦈ = (ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F (RK_σ23 𝔗 ε' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23))⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ∈⇩∘ 2⇩ℕ"
then consider ‹a = 0› | ‹a = 1⇩ℕ› unfolding two by auto
then show
"ε'⦇NTMap⦈⦇a⦈ =
(ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F (RK_σ23 𝔗 ε' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23))⦇NTMap⦈⦇a⦈"
by (cases; use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp:
omega_of_set
cat_Kan_cs_simps
cat_cs_simps
cat_ordinal_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros nat_omega_intros
)+
qed (use rhs in ‹cs_concl cs_simp: cs_intro: V_cs_intros cat_cs_intros›)+
qed simp_all
fix σ assume prems':
"σ : 𝔉' ↦⇩C⇩F RK23 𝔗 : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
"ε' = ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23)"
interpret σ: is_ntcf α ‹cat_ordinal (3⇩ℕ)› 𝔄 𝔉' ‹RK23 𝔗› σ
by (rule prems'(1))
from prems'(2) have
"ε'⦇NTMap⦈⦇0⦈ = (ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23))⦇NTMap⦈⦇0⦈"
by auto
then have [cat_cs_simps]: "ε'⦇NTMap⦈⦇0⦈ = σ⦇NTMap⦈⦇0⦈"
by
(
cs_prems
cs_simp: cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
cs_intro: cat_cs_intros nat_omega_intros
)
from prems'(2) have
"ε'⦇NTMap⦈⦇1⇩ℕ⦈ = (ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23))⦇NTMap⦈⦇1⇩ℕ⦈"
by auto
then have [cat_cs_simps]: "ε'⦇NTMap⦈⦇1⇩ℕ⦈ = σ⦇NTMap⦈⦇2⇩ℕ⦈"
by
(
cs_prems
cs_simp:
omega_of_set cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
cs_intro: cat_cs_intros nat_omega_intros
)
show "σ = RK_σ23 𝔗 ε' 𝔉'"
proof(rule ntcf_eqI)
show "σ : 𝔉' ↦⇩C⇩F RK23 𝔗 : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
by (rule prems'(1))
then have dom_lhs: "𝒟⇩∘ (σ⦇NTMap⦈) = 3⇩ℕ"
by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
show "RK_σ23 𝔗 ε' 𝔉' : 𝔉' ↦⇩C⇩F RK23 𝔗 : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
then have dom_rhs: "𝒟⇩∘ (RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈) = 3⇩ℕ"
by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
from 0123 have 013: "[0, 1⇩ℕ]⇩∘ : 0 ↦⇘cat_ordinal (3⇩ℕ)⇙ 1⇩ℕ"
by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
from 0123 have 123: "[1⇩ℕ, 2⇩ℕ]⇩∘ : 1⇩ℕ ↦⇘cat_ordinal (3⇩ℕ)⇙ 2⇩ℕ"
by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
from σ.ntcf_Comp_commute[OF 123] 013 0123
have [symmetric, cat_Kan_cs_simps]:
"σ⦇NTMap⦈⦇2⇩ℕ⦈ ∘⇩A⇘𝔄⇙ 𝔉'⦇ArrMap⦈ ⦇1⇩ℕ, 2⇩ℕ⦈⇩∙ = σ⦇NTMap⦈⦇1⇩ℕ⦈"
by
(
cs_prems
cs_simp: cat_cs_simps cat_Kan_cs_simps RK23_ArrMap_app_12
cs_intro: cat_cs_intros
)
show "σ⦇NTMap⦈ = RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ∈⇩∘ 3⇩ℕ"
then consider ‹a = 0› | ‹a = 1⇩ℕ› | ‹a = 2⇩ℕ› unfolding three by auto
then show "σ⦇NTMap⦈⦇a⦈ = RK_σ23 𝔗 ε' 𝔉'⦇NTMap⦈⦇a⦈"
by (cases; use nothing in ‹simp_all only:›)
(cs_concl cs_simp: cat_cs_simps cat_Kan_cs_simps)+
qed auto
qed simp_all
qed
qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+
qed
subsection‹
‹LK_σ23›: towards the universal property of the left Kan extension along ‹𝔎23›
›
subsubsection‹Definition and elementary properties›
definition LK_σ23 :: "V ⇒ V ⇒ V ⇒ V"
where "LK_σ23 𝔗 η' 𝔉' =
[
(
λa∈⇩∘cat_ordinal (3⇩ℕ)⦇Obj⦈.
if a = 0 ⇒ η'⦇NTMap⦈⦇0⦈
| a = 1⇩ℕ ⇒ 𝔉'⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙ ∘⇩A⇘𝔗⦇HomCod⦈⇙ η'⦇NTMap⦈⦇0⦈
| a = 2⇩ℕ ⇒ η'⦇NTMap⦈⦇1⇩ℕ⦈
| otherwise ⇒ 𝔗⦇HomCod⦈⦇Arr⦈
),
LK23 𝔗,
𝔉',
cat_ordinal (3⇩ℕ),
𝔉'⦇HomCod⦈
]⇩∘"
text‹Components.›
lemma LK_σ23_components:
shows "LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈ =
(
λa∈⇩∘cat_ordinal (3⇩ℕ)⦇Obj⦈.
if a = 0 ⇒ η'⦇NTMap⦈⦇0⦈
| a = 1⇩ℕ ⇒ 𝔉'⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙ ∘⇩A⇘𝔗⦇HomCod⦈⇙ η'⦇NTMap⦈⦇0⦈
| a = 2⇩ℕ ⇒ η'⦇NTMap⦈⦇1⇩ℕ⦈
| otherwise ⇒ 𝔗⦇HomCod⦈⦇Arr⦈
)"
and "LK_σ23 𝔗 η' 𝔉'⦇NTDom⦈ = LK23 𝔗"
and "LK_σ23 𝔗 η' 𝔉'⦇NTCod⦈ = 𝔉'"
and "LK_σ23 𝔗 η' 𝔉'⦇NTDGDom⦈ = cat_ordinal (3⇩ℕ)"
and "LK_σ23 𝔗 η' 𝔉'⦇NTDGCod⦈ = 𝔉'⦇HomCod⦈"
unfolding LK_σ23_def nt_field_simps by (simp_all add: nat_omega_simps)
context
fixes α 𝔄 𝔉' 𝔗
assumes 𝔉': "𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
and 𝔗: "𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
begin
interpretation 𝔉': is_functor α ‹cat_ordinal (3⇩ℕ)› 𝔄 𝔉' by (rule 𝔉')
interpretation 𝔗: is_functor α ‹cat_ordinal (2⇩ℕ)› 𝔄 𝔗 by (rule 𝔗)
lemmas LK_σ23_components' =
LK_σ23_components[where 𝔉'=𝔉' and 𝔗=𝔗, unfolded cat_cs_simps]
lemmas [cat_Kan_cs_simps] = LK_σ23_components'(2-5)
end
subsubsection‹Natural transformation map›
mk_VLambda LK_σ23_components(1)
|vsv LK_σ23_NTMap_vsv[cat_Kan_cs_intros]|
|vdomain LK_σ23_NTMap_vdomain[cat_Kan_cs_simps]|
|app LK_σ23_NTMap_app|
lemma LK_σ23_NTMap_app_0[cat_Kan_cs_simps]:
assumes "a = 0"
shows "LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇a⦈ = η'⦇NTMap⦈⦇0⦈"
using assms unfolding LK_σ23_components cat_ordinal_cs_simps by simp
lemma (in is_functor) LK_σ23_NTMap_app_1[cat_Kan_cs_simps]:
assumes "a = 1⇩ℕ"
shows "LK_σ23 𝔉 η' 𝔉'⦇NTMap⦈⦇a⦈ = 𝔉'⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙ ∘⇩A⇘𝔅⇙ η'⦇NTMap⦈⦇0⦈"
using assms unfolding LK_σ23_components cat_ordinal_cs_simps cat_cs_simps by simp
lemmas [cat_Kan_cs_simps] = is_functor.LK_σ23_NTMap_app_1
lemma LK_σ23_NTMap_app_2[cat_Kan_cs_simps]:
assumes "a = 2⇩ℕ"
shows "LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇a⦈ = η'⦇NTMap⦈⦇1⇩ℕ⦈"
using assms unfolding LK_σ23_components cat_ordinal_cs_simps by simp
subsubsection‹‹LK_σ23› is a natural transformation›
lemma LK_σ23_is_ntcf:
assumes "𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
and "𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
and "η' : 𝔗 ↦⇩C⇩F 𝔉' ∘⇩C⇩F 𝔎23 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
shows "LK_σ23 𝔗 η' 𝔉' : LK23 𝔗 ↦⇩C⇩F 𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
proof-
interpret 𝔉': is_functor α ‹cat_ordinal (3⇩ℕ)› 𝔄 𝔉' by (rule assms(1))
interpret 𝔗: is_functor α ‹cat_ordinal (2⇩ℕ)› 𝔄 𝔗 by (rule assms(2))
interpret η': is_ntcf α ‹cat_ordinal (2⇩ℕ)› 𝔄 𝔗 ‹𝔉' ∘⇩C⇩F 𝔎23› η'
by (rule assms(3))
interpret 𝔎23: is_functor α ‹cat_ordinal (2⇩ℕ)› ‹cat_ordinal (3⇩ℕ)› ‹𝔎23›
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
interpret LK23: is_functor α ‹cat_ordinal (3⇩ℕ)› 𝔄 ‹LK23 𝔗›
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
show ?thesis
proof(rule is_ntcfI')
show "vfsequence (LK_σ23 𝔗 η' 𝔉')" unfolding LK_σ23_def by simp
show "vcard (LK_σ23 𝔗 η' 𝔉') = 5⇩ℕ"
unfolding LK_σ23_def by (simp_all add: nat_omega_simps)
show "LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇a⦈ : LK23 𝔗⦇ObjMap⦈⦇a⦈ ↦⇘𝔄⇙ 𝔉'⦇ObjMap⦈⦇a⦈"
if "a ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Obj⦈" for a
proof-
from that consider ‹a = 0› | ‹a = 1⇩ℕ› | ‹a = 2⇩ℕ›
unfolding cat_ordinal_cs_simps three by auto
from this 0123 show
"LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇a⦈ : LK23 𝔗⦇ObjMap⦈⦇a⦈ ↦⇘𝔄⇙ 𝔉'⦇ObjMap⦈⦇a⦈"
by (cases, use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp: cat_cs_simps cat_ordinal_cs_simps cat_Kan_cs_simps
cs_intro:
cat_cs_intros
cat_ordinal_cs_intros
cat_Kan_cs_intros
nat_omega_intros
)+
qed
show
"LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇b⦈ ∘⇩A⇘𝔄⇙ LK23 𝔗⦇ArrMap⦈⦇f⦈ =
𝔉'⦇ArrMap⦈⦇f⦈ ∘⇩A⇘𝔄⇙ LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇a⦈"
if "f : a ↦⇘cat_ordinal (3⇩ℕ)⇙ b" for a b f
using that 0123
by (elim cat_ordinal_3_is_arrE, use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp:
cat_cs_simps
cat_ordinal_cs_simps
𝔉'.cf_ArrMap_Comp[symmetric]
𝔉'.HomCod.cat_Comp_assoc[symmetric]
η'.ntcf_Comp_commute
cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
)+
qed
(
cs_concl
cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros cat_Kan_cs_intros
)+
qed
lemma LK_σ23_is_ntcf'[cat_Kan_cs_intros]:
assumes "𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
and "𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
and "η' : 𝔗 ↦⇩C⇩F 𝔉' ∘⇩C⇩F 𝔎23 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
and "𝔊' = LK23 𝔗"
and "ℌ' = 𝔉'"
and "ℭ' = cat_ordinal (3⇩ℕ)"
shows "LK_σ23 𝔗 η' 𝔉' : 𝔊' ↦⇩C⇩F ℌ': ℭ' ↦↦⇩C⇘α⇙ 𝔄"
using assms(1-3) unfolding assms(4-6) by (rule LK_σ23_is_ntcf)
subsection‹The left Kan extension along ‹𝔎23››
lemma η23_is_cat_rKe:
assumes "𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
shows "ntcf_id 𝔗 :
𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ LK23 𝔗 ∘⇩C⇩F 𝔎23 : cat_ordinal (2⇩ℕ) ↦⇩C cat_ordinal (3⇩ℕ) ↦⇩C 𝔄"
proof-
interpret 𝔗: is_functor α ‹cat_ordinal (2⇩ℕ)› 𝔄 𝔗 by (rule assms(1))
interpret 𝔎23: is_functor α ‹cat_ordinal (2⇩ℕ)› ‹cat_ordinal (3⇩ℕ)› ‹𝔎23›
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
interpret LK23: is_functor α ‹cat_ordinal (3⇩ℕ)› 𝔄 ‹LK23 𝔗›
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
show ?thesis
proof(intro is_cat_lKeI')
fix 𝔉' η' assume prems:
"𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
"η' : 𝔗 ↦⇩C⇩F 𝔉' ∘⇩C⇩F 𝔎23 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
interpret 𝔉': is_functor α ‹cat_ordinal (3⇩ℕ)› 𝔄 𝔉' by (rule prems(1))
interpret η': is_ntcf α ‹cat_ordinal (2⇩ℕ)› 𝔄 𝔗 ‹𝔉' ∘⇩C⇩F 𝔎23› η'
by (rule prems(2))
interpret LK_σ23: is_ntcf α ‹cat_ordinal (3⇩ℕ)› 𝔄 ‹LK23 𝔗› 𝔉' ‹LK_σ23 𝔗 η' 𝔉'›
by (intro LK_σ23_is_ntcf prems assms)
show "∃!σ.
σ : LK23 𝔗 ↦⇩C⇩F 𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄 ∧
η' = σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23 ∙⇩N⇩T⇩C⇩F ntcf_id 𝔗"
proof(intro ex1I conjI; (elim conjE)?)
show "LK_σ23 𝔗 η' 𝔉' : LK23 𝔗 ↦⇩C⇩F 𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
by (intro LK_σ23.is_ntcf_axioms)
show "η' = LK_σ23 𝔗 η' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23 ∙⇩N⇩T⇩C⇩F ntcf_id 𝔗"
proof(rule ntcf_eqI)
show "η' : 𝔗 ↦⇩C⇩F 𝔉' ∘⇩C⇩F 𝔎23 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
by (intro prems)
then have dom_lhs: "𝒟⇩∘ (η'⦇NTMap⦈) = 2⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show rhs:
"LK_σ23 𝔗 η' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23 ∙⇩N⇩T⇩C⇩F ntcf_id 𝔗 :
𝔗 ↦⇩C⇩F 𝔉' ∘⇩C⇩F 𝔎23 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
then have dom_rhs:
"𝒟⇩∘ ((LK_σ23 𝔗 η' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23 ∙⇩N⇩T⇩C⇩F ntcf_id 𝔗)⦇NTMap⦈) = 2⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show "η'⦇NTMap⦈ = (LK_σ23 𝔗 η' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23 ∙⇩N⇩T⇩C⇩F ntcf_id 𝔗)⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ∈⇩∘ 2⇩ℕ"
then consider ‹a = 0› | ‹a = 1⇩ℕ› unfolding two by auto
then show
"η'⦇NTMap⦈⦇a⦈ =
(LK_σ23 𝔗 η' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23 ∙⇩N⇩T⇩C⇩F ntcf_id 𝔗)⦇NTMap⦈⦇a⦈"
by (cases; use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp:
omega_of_set
cat_Kan_cs_simps
cat_cs_simps
cat_ordinal_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros nat_omega_intros
)+
qed (use rhs in ‹cs_concl cs_simp: cs_intro: V_cs_intros cat_cs_intros›)+
qed simp_all
fix σ assume prems':
"σ : LK23 𝔗 ↦⇩C⇩F 𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
"η' = σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23 ∙⇩N⇩T⇩C⇩F ntcf_id 𝔗"
interpret σ: is_ntcf α ‹cat_ordinal (3⇩ℕ)› 𝔄 ‹LK23 𝔗› 𝔉' σ
by (rule prems'(1))
from prems'(2) have
"η'⦇NTMap⦈⦇0⦈ = (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23 ∙⇩N⇩T⇩C⇩F ntcf_id 𝔗)⦇NTMap⦈⦇0⦈"
by auto
then have [cat_cs_simps]: "η'⦇NTMap⦈⦇0⦈ = σ⦇NTMap⦈⦇0⦈"
by
(
cs_prems
cs_simp: cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
cs_intro: cat_cs_intros nat_omega_intros
)
from prems'(2) have
"η'⦇NTMap⦈⦇1⇩ℕ⦈ = (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23 ∙⇩N⇩T⇩C⇩F ntcf_id 𝔗)⦇NTMap⦈⦇1⇩ℕ⦈"
by auto
then have [cat_cs_simps]: "η'⦇NTMap⦈⦇1⇩ℕ⦈ = σ⦇NTMap⦈⦇2⇩ℕ⦈"
by
(
cs_prems
cs_simp:
omega_of_set cat_Kan_cs_simps cat_cs_simps cat_ordinal_cs_simps
cs_intro: cat_cs_intros nat_omega_intros
)
show "σ = LK_σ23 𝔗 η' 𝔉'"
proof(rule ntcf_eqI)
show "σ : LK23 𝔗 ↦⇩C⇩F 𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
by (rule prems'(1))
then have dom_lhs: "𝒟⇩∘ (σ⦇NTMap⦈) = 3⇩ℕ"
by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
show "LK_σ23 𝔗 η' 𝔉' : LK23 𝔗 ↦⇩C⇩F 𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
then have dom_rhs: "𝒟⇩∘ (LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈) = 3⇩ℕ"
by (cs_concl cs_simp: cat_cs_simps cat_ordinal_cs_simps)
from 0123 have 012: "[0, 1⇩ℕ]⇩∘ : 0 ↦⇘cat_ordinal (2⇩ℕ)⇙ 1⇩ℕ"
by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
from 0123 have 013: "[0, 1⇩ℕ]⇩∘ : 0 ↦⇘cat_ordinal (3⇩ℕ)⇙ 1⇩ℕ"
by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
from 0123 have 00: "[0, 0]⇩∘ = (cat_ordinal (2⇩ℕ))⦇CId⦈⦇0⦈"
by (cs_concl cs_simp: cat_ordinal_cs_simps)
from σ.ntcf_Comp_commute[OF 013] 013 0123
have [symmetric, cat_Kan_cs_simps]:
"σ⦇NTMap⦈⦇1⇩ℕ⦈ = 𝔉'⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙ ∘⇩A⇘𝔄⇙ σ⦇NTMap⦈⦇0⦈"
by
(
cs_prems
cs_simp: cat_cs_simps cat_Kan_cs_simps 00 LK23_ArrMap_app_01
cs_intro: cat_cs_intros cat_ordinal_cs_intros nat_omega_intros
)
show "σ⦇NTMap⦈ = LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix a assume prems: "a ∈⇩∘ 3⇩ℕ"
then consider ‹a = 0› | ‹a = 1⇩ℕ› | ‹a = 2⇩ℕ› unfolding three by auto
then show "σ⦇NTMap⦈⦇a⦈ = LK_σ23 𝔗 η' 𝔉'⦇NTMap⦈⦇a⦈"
by (cases; use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros
)+
qed auto
qed simp_all
qed
qed (cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+
qed
subsection‹Pointwise Kan extensions along ‹𝔎23››
lemma ε23_is_cat_pw_rKe:
assumes "𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
shows "ntcf_id 𝔗 :
RK23 𝔗 ∘⇩C⇩F 𝔎23 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇩.⇩p⇩w⇘α⇙ 𝔗 :
cat_ordinal (2⇩ℕ) ↦⇩C cat_ordinal (3⇩ℕ) ↦⇩C 𝔄"
proof-
interpret 𝔗: is_functor α ‹cat_ordinal (2⇩ℕ)› 𝔄 𝔗 by (rule assms(1))
show ?thesis
proof(intro is_cat_pw_rKeI ε23_is_cat_rKe[OF assms])
fix a assume prems: "a ∈⇩∘ 𝔄⦇Obj⦈"
show
"ntcf_id 𝔗 :
RK23 𝔗 ∘⇩C⇩F 𝔎23 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ 𝔗 :
cat_ordinal (2⇩ℕ) ↦⇩C
cat_ordinal (3⇩ℕ) ↦⇩C
(Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) : 𝔄 ↦↦⇩C cat_Set α)"
proof(intro is_cat_rKe_preservesI ε23_is_cat_rKe[OF assms])
from prems show "Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) : 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
show "Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗 :
(Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗) ∘⇩C⇩F 𝔎23 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗 :
cat_ordinal (2⇩ℕ) ↦⇩C cat_ordinal (3⇩ℕ) ↦⇩C cat_Set α"
proof(intro is_cat_rKeI')
show "𝔎23 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ cat_ordinal (3⇩ℕ)"
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros)
from prems show
"Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗 : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_simp: cs_intro: cat_cs_intros cat_Kan_cs_intros)
from prems show
"Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗 :
Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗 ∘⇩C⇩F 𝔎23 ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗 :
cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
fix 𝔊' ε' assume prems':
"𝔊' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α"
"ε' :
𝔊' ∘⇩C⇩F 𝔎23 ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗 :
cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α"
interpret 𝔊': is_functor α ‹cat_ordinal (3⇩ℕ)› ‹cat_Set α› 𝔊'
by (rule prems'(1))
interpret ε': is_ntcf
α
‹cat_ordinal (2⇩ℕ)›
‹cat_Set α›
‹𝔊' ∘⇩C⇩F 𝔎23›
‹Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗›
ε'
by (rule prems'(2))
show "∃!σ.
σ :
𝔊' ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗 :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α ∧
ε' = Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23)"
proof(intro ex1I conjI; (elim conjE)?)
have [cat_Kan_cs_simps]:
"Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗 = RK23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗)"
proof(rule cf_eqI)
from prems show lhs: "Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗 :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
from prems show rhs: "RK23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗) :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros
)
from lhs prems have ObjMap_dom_lhs:
"𝒟⇩∘ ((Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗)⦇ObjMap⦈) = 3⇩ℕ"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
from rhs prems have ObjMap_dom_rhs:
"𝒟⇩∘ ((RK23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗))⦇ObjMap⦈) = 3⇩ℕ"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps
cs_intro: cat_Kan_cs_intros
)
show
"(Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗)⦇ObjMap⦈ =
RK23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗)⦇ObjMap⦈"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix c assume prems'': "c ∈⇩∘ 3⇩ℕ"
with 0123 consider ‹c = 0› | ‹c = 1⇩ℕ› | ‹c = 2⇩ℕ› by force
from this prems prems'' 0123 show
"(Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗)⦇ObjMap⦈⦇c⦈ =
RK23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗)⦇ObjMap⦈⦇c⦈"
by (cases; use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_cs_simps
cat_op_simps
cat_Kan_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)+
qed
(
use prems in ‹
cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros
›
)+
from lhs prems have ArrMap_dom_lhs:
"𝒟⇩∘ ((Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗)⦇ArrMap⦈) =
cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
from rhs prems have ArrMap_dom_rhs:
"𝒟⇩∘ ((RK23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗))⦇ArrMap⦈) =
cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps
cs_intro: cat_Kan_cs_intros
)
show
"(Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗)⦇ArrMap⦈ =
RK23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗)⦇ArrMap⦈"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix f assume prems'': "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
then obtain a' b' where "f : a' ↦⇘cat_ordinal (3⇩ℕ)⇙ b'" by auto
from this 0123 prems show
"(Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗)⦇ArrMap⦈⦇f⦈ =
RK23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗)⦇ArrMap⦈⦇f⦈"
by
(
elim cat_ordinal_3_is_arrE;
use nothing in ‹simp_all only:›
)
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
cs_intro:
cat_ordinal_cs_intros
cat_Kan_cs_intros
cat_cs_intros
nat_omega_intros
)+
qed
(
use prems in
‹cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros›
)+
qed simp_all
show "RK_σ23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗) ε' 𝔊' :
𝔊' ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗 :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α"
by (intro RK_σ23_is_ntcf')
(cs_concl cs_simp: cat_Kan_cs_simps cs_intro: cat_cs_intros)+
show "ε' =
Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F
ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F
(RK_σ23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗) ε' 𝔊' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23)"
proof(rule ntcf_eqI)
show "ε' :
𝔊' ∘⇩C⇩F 𝔎23 ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗 :
cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α"
by (intro prems')
then have dom_lhs: "𝒟⇩∘ (ε'⦇NTMap⦈) = 2⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
from prems show
"Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F
ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F
(RK_σ23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗) ε' 𝔊' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23) :
𝔊' ∘⇩C⇩F 𝔎23 ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗 :
cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
then have dom_rhs:
"𝒟⇩∘
(
(Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F
ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F
(RK_σ23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗) ε' 𝔊' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23)
)⦇NTMap⦈) = 2⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show "ε'⦇NTMap⦈ =
(
Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F
ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F
(RK_σ23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗) ε' 𝔊' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23)
)⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix c assume prems'': "c ∈⇩∘ 2⇩ℕ"
then consider ‹c = 0› | ‹c = 1⇩ℕ› unfolding two by auto
from this prems 0123 show "ε'⦇NTMap⦈⦇c⦈ =
(
Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F
ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F
(RK_σ23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗) ε' 𝔊' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23)
)⦇NTMap⦈⦇c⦈"
by (cases; use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp:
cat_Kan_cs_simps
cat_ordinal_cs_simps
cat_cs_simps
cat_op_simps
cat_Set_components(1)
cs_intro:
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
𝔗.HomCod.cat_Hom_in_Vset
)+
qed (cs_concl cs_simp: cs_intro: cat_cs_intros V_cs_intros)+
qed simp_all
fix σ assume prems'':
"σ :
𝔊' ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗 :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α"
"ε' =
Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23)"
interpret σ: is_ntcf
α ‹cat_ordinal (3⇩ℕ)› ‹cat_Set α› 𝔊' ‹Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗› σ
by (rule prems''(1))
from prems''(2) have "ε'⦇NTMap⦈⦇0⦈ =
(Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F (σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23))⦇NTMap⦈⦇0⦈"
by auto
from this prems 0123 have ε'_NTMap_app_0: "ε'⦇NTMap⦈⦇0⦈ = σ⦇NTMap⦈⦇0⦈"
by
(
cs_prems
cs_simp:
cat_ordinal_cs_simps
cat_cs_simps
cat_Kan_cs_simps
cat_op_simps
𝔎23_ObjMap_app_0
cat_Set_components(1)
cs_intro:
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
𝔗.HomCod.cat_Hom_in_Vset
)
from 0123 have 01: "[0, 1⇩ℕ]⇩∘ : 0 ↦⇘cat_ordinal (2⇩ℕ)⇙ 1⇩ℕ"
by
(
cs_concl
cs_simp: cat_cs_simps
cs_intro: cat_ordinal_cs_intros nat_omega_intros
)
from prems''(2) have
"ε'⦇NTMap⦈⦇1⇩ℕ⦈ =
(
Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F
ntcf_id 𝔗 ∙⇩N⇩T⇩C⇩F
(σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23)
)⦇NTMap⦈⦇1⇩ℕ⦈"
by auto
from this prems 0123 have ε'_NTMap_app_1:
"ε'⦇NTMap⦈⦇1⇩ℕ⦈ = σ⦇NTMap⦈⦇2⇩ℕ⦈"
by
(
cs_prems
cs_simp:
cat_ordinal_cs_simps
cat_cs_simps
cat_Kan_cs_simps
cat_op_simps
𝔎23_ObjMap_app_1
cat_Set_components(1)
cs_intro:
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
𝔗.HomCod.cat_Hom_in_Vset
)
from 0123 have 012: "[0, 1⇩ℕ]⇩∘ : 0 ↦⇘cat_ordinal (2⇩ℕ)⇙ 1⇩ℕ"
by
(
cs_concl cs_simp: cs_intro:
cat_ordinal_cs_intros nat_omega_intros
)
from 0123 have 013: "[0, 1⇩ℕ]⇩∘ : 0 ↦⇘cat_ordinal (3⇩ℕ)⇙ 1⇩ℕ"
by
(
cs_concl cs_simp: cs_intro:
cat_ordinal_cs_intros nat_omega_intros
)
from 0123 have 123: "[1⇩ℕ, 2⇩ℕ]⇩∘ : 1⇩ℕ ↦⇘cat_ordinal (3⇩ℕ)⇙ 2⇩ℕ"
by
(
cs_concl cs_simp: cs_intro:
cat_ordinal_cs_intros nat_omega_intros
)
from 0123 have 11: "[1⇩ℕ, 1⇩ℕ]⇩∘ = (cat_ordinal (2⇩ℕ))⦇CId⦈⦇1⇩ℕ⦈"
by (cs_concl cs_simp: cat_ordinal_cs_simps)
from σ.ntcf_Comp_commute[OF 123] prems 012 013
have [cat_Kan_cs_simps]:
"ε'⦇NTMap⦈⦇1⇩ℕ⦈ ∘⇩A⇘cat_Set α⇙ 𝔊'⦇ArrMap⦈⦇1⇩ℕ, 2⇩ℕ⦈⇩∙ = σ⦇NTMap⦈⦇1⇩ℕ⦈"
by
(
cs_prems 1
cs_simp:
cat_cs_simps
cat_Kan_cs_simps
ε'_NTMap_app_1[symmetric]
is_functor.cf_ObjMap_CId
RK23_ArrMap_app_12
11
cs_intro: cat_cs_intros nat_omega_intros
)
show "σ = RK_σ23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗) ε' 𝔊'"
proof(rule ntcf_eqI)
show σ: "σ :
𝔊' ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗 :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α"
by (rule prems''(1))
then have dom_lhs: "𝒟⇩∘ (σ⦇NTMap⦈) = 3⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show "RK_σ23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗) ε' 𝔊' :
𝔊' ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F RK23 𝔗 :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ cat_Set α"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
then have dom_rhs:
"𝒟⇩∘ (RK_σ23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗) ε' 𝔊'⦇NTMap⦈) = 3⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show "σ⦇NTMap⦈ = RK_σ23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗) ε' 𝔊'⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix c assume "c ∈⇩∘ 3⇩ℕ"
then consider ‹c = 0› | ‹c = 1⇩ℕ› | ‹c = 2⇩ℕ›
unfolding three by auto
from this 0123 show
"σ⦇NTMap⦈⦇c⦈ = RK_σ23 (Hom⇩O⇩.⇩C⇘α⇙𝔄(a,-) ∘⇩C⇩F 𝔗) ε' 𝔊'⦇NTMap⦈⦇c⦈"
by (cases; use nothing in ‹simp_all only:›)
(
cs_concl cs_simp:
cat_Kan_cs_simps ε'_NTMap_app_1 ε'_NTMap_app_0
)+
qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros V_cs_intros)+
qed simp_all
qed
qed
qed
qed
qed
lemma η23_is_cat_pw_lKe:
assumes "𝔗 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ 𝔄"
shows "ntcf_id 𝔗 :
𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇩.⇩p⇩w⇘α⇙ LK23 𝔗 ∘⇩C⇩F 𝔎23 :
cat_ordinal (2⇩ℕ) ↦⇩C cat_ordinal (3⇩ℕ) ↦⇩C 𝔄"
proof-
interpret 𝔗: is_functor α ‹cat_ordinal (2⇩ℕ)› 𝔄 𝔗 by (rule assms(1))
from ord_of_nat_ω interpret cat_ordinal_3: finite_category α ‹cat_ordinal (3⇩ℕ)›
by (cs_concl cs_intro: cat_ordinal_cs_intros)
from 0123 have 002: "[0, 0]⇩∘ : 0 ↦⇘cat_ordinal (2⇩ℕ)⇙ 0"
by (cs_concl cs_simp: cat_ordinal_cs_simps cs_intro: cat_cs_intros)
show ?thesis
proof(intro is_cat_pw_lKeI η23_is_cat_rKe assms, unfold cat_op_simps)
fix a assume prems: "a ∈⇩∘ 𝔄⦇Obj⦈"
show
"op_ntcf (ntcf_id 𝔗) :
op_cf (LK23 𝔗) ∘⇩C⇩F op_cf 𝔎23 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ op_cf 𝔗 :
op_cat (cat_ordinal (2⇩ℕ)) ↦⇩C op_cat (cat_ordinal (3⇩ℕ)) ↦⇩C
(Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) : op_cat 𝔄 ↦↦⇩C cat_Set α)"
proof(intro is_cat_rKe_preservesI)
show
"op_ntcf (ntcf_id 𝔗) :
op_cf (LK23 𝔗) ∘⇩C⇩F op_cf 𝔎23 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙ op_cf 𝔗 :
op_cat (cat_ordinal (2⇩ℕ)) ↦⇩C op_cat (cat_ordinal (3⇩ℕ)) ↦⇩C op_cat 𝔄"
proof(cs_intro_step cat_op_intros)
show "ntcf_id 𝔗 :
𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙ LK23 𝔗 ∘⇩C⇩F 𝔎23 :
cat_ordinal (2⇩ℕ) ↦⇩C cat_ordinal (3⇩ℕ) ↦⇩C 𝔄"
by (intro η23_is_cat_rKe assms)
qed simp_all
from prems show "Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) : op_cat 𝔄 ↦↦⇩C⇘α⇙ cat_Set α"
by (cs_concl cs_simp: cs_intro: cat_cs_intros)
have
"op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗 :
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗 ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙
(op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗) ∘⇩C⇩F 𝔎23 :
cat_ordinal (2⇩ℕ) ↦⇩C cat_ordinal (3⇩ℕ) ↦⇩C op_cat (cat_Set α)"
proof(intro is_cat_lKeI')
show "𝔎23 : cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ cat_ordinal (3⇩ℕ)"
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros)
from prems show "op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗 :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)
from prems show
"op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗 :
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗 ↦⇩C⇩F
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗 ∘⇩C⇩F 𝔎23 :
cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)
fix 𝔉' η' assume prems':
"𝔉' : cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α)"
"η' :
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗 ↦⇩C⇩F 𝔉' ∘⇩C⇩F 𝔎23 :
cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α)"
interpret 𝔉': is_functor α ‹cat_ordinal (3⇩ℕ)› ‹op_cat (cat_Set α)› 𝔉'
by (rule prems'(1))
interpret η': is_ntcf
α
‹cat_ordinal (2⇩ℕ)›
‹op_cat (cat_Set α)›
‹op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗›
‹𝔉' ∘⇩C⇩F 𝔎23›
η'
by (rule prems'(2))
note [unfolded cat_op_simps, cat_cs_intros] =
η'.ntcf_NTMap_is_arr'
𝔉'.cf_ArrMap_is_arr'
show
"∃!σ.
σ :
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗 ↦⇩C⇩F 𝔉' :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α) ∧
η' = σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23 ∙⇩N⇩T⇩C⇩F (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗)"
proof(intro ex1I conjI; (elim conjE)?)
have [cat_Kan_cs_simps]:
"op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗 =
LK23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗)"
proof(rule cf_eqI)
from prems show lhs: "op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗 :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α)"
by
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)
from prems show rhs: "LK23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗) :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α)"
by (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros cat_cs_intros)
from lhs prems have ObjMap_dom_lhs:
"𝒟⇩∘ ((op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗)⦇ObjMap⦈) = 3⇩ℕ"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
from rhs prems have ObjMap_dom_rhs:
"𝒟⇩∘ (LK23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗)⦇ObjMap⦈) = 3⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show
"(op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗)⦇ObjMap⦈ =
LK23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗)⦇ObjMap⦈"
proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
fix c assume prems'': "c ∈⇩∘ 3⇩ℕ"
then consider ‹c = 0› | ‹c = 1⇩ℕ› | ‹c = 2⇩ℕ›
unfolding three by auto
from this prems 0123 show
"(op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗)⦇ObjMap⦈⦇c⦈ =
LK23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗)⦇ObjMap⦈⦇c⦈"
by (cases; use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
cat_cs_simps
cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)+
qed
(
use prems in
‹
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
›
)+
from lhs prems have ArrMap_dom_lhs:
"𝒟⇩∘ ((op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗)⦇ArrMap⦈) =
cat_ordinal (3⇩ℕ)⦇Arr⦈"
by
(
cs_concl
cs_simp: cat_ordinal_cs_simps cat_cs_simps cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
from rhs prems have ArrMap_dom_rhs:
"𝒟⇩∘ (LK23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗)⦇ArrMap⦈) =
cat_ordinal (3⇩ℕ)⦇Arr⦈"
by (cs_concl cs_simp: cat_cs_simps)
show
"(op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗)⦇ArrMap⦈ =
LK23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗)⦇ArrMap⦈"
proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
fix f assume "f ∈⇩∘ cat_ordinal (3⇩ℕ)⦇Arr⦈"
then obtain a' b' where f: "f : a' ↦⇘cat_ordinal (3⇩ℕ)⇙ b'"
by auto
from f prems 0123 002 show
"(op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗)⦇ArrMap⦈⦇f⦈ =
LK23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗)⦇ArrMap⦈⦇f⦈"
by (elim cat_ordinal_3_is_arrE, (simp_all only:)?)
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
cs_intro:
cat_ordinal_cs_intros
cat_Kan_cs_intros
cat_cs_intros
cat_op_intros
nat_omega_intros
)+
qed
(
use prems in
‹
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros›
)+
qed simp_all
show "LK_σ23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗) η' 𝔉' :
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗 ↦⇩C⇩F 𝔉' :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α)"
by
(
cs_concl
cs_simp: cat_cs_simps cat_Kan_cs_simps cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)
show "η' =
LK_σ23
(
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗) η' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F
𝔎23 ∙⇩N⇩T⇩C⇩F
(op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗
)"
proof(rule ntcf_eqI)
show lhs: "η' :
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗 ↦⇩C⇩F 𝔉' ∘⇩C⇩F 𝔎23 :
cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α)"
by (rule prems'(2))
from lhs have "𝒟⇩∘ (η'⦇NTMap⦈) = cat_ordinal (2⇩ℕ)⦇Obj⦈"
by (cs_concl cs_simp: cat_cs_simps)
from prems show rhs:
"LK_σ23
(
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗) η' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F
𝔎23 ∙⇩N⇩T⇩C⇩F
(op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗
) :
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗 ↦⇩C⇩F 𝔉' ∘⇩C⇩F 𝔎23 :
cat_ordinal (2⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α)"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)
from lhs have dom_lhs: "𝒟⇩∘ (η'⦇NTMap⦈) = 2⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
from rhs have dom_rhs: "𝒟⇩∘ ((LK_σ23
(
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗) η' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F
𝔎23 ∙⇩N⇩T⇩C⇩F
(op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗
))⦇NTMap⦈) = 2⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show
"η'⦇NTMap⦈ =
(
LK_σ23
(
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗) η' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F
𝔎23 ∙⇩N⇩T⇩C⇩F
(op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗
)
)⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs cat_ordinal_cs_simps)
fix c assume "c ∈⇩∘ 2⇩ℕ"
then consider ‹c = 0› | ‹c = 1⇩ℕ› unfolding two by auto
from this prems 0123 show
"η'⦇NTMap⦈⦇c⦈ =
(
LK_σ23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗) η' 𝔉' ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F
𝔎23 ∙⇩N⇩T⇩C⇩F (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗)
)⦇NTMap⦈⦇c⦈"
by (cases, use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
cat_cs_simps
cat_op_simps
𝔎23_ObjMap_app_1
𝔎23_ObjMap_app_0
LK_σ23_NTMap_app_0
cat_Set_components(1)
cs_intro:
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_op_intros
𝔗.HomCod.cat_Hom_in_Vset
)+
qed (cs_concl cs_simp: cs_intro: V_cs_intros cat_cs_intros)+
qed simp_all
fix σ assume prems'':
"σ :
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗 ↦⇩C⇩F 𝔉' :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α)"
"η' = σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F 𝔎23 ∙⇩N⇩T⇩C⇩F (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗)"
interpret σ: is_ntcf
α
‹cat_ordinal (3⇩ℕ)› ‹op_cat (cat_Set α)›
‹op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗›
𝔉'
σ
by (rule prems''(1))
note [cat_Kan_cs_intros] = σ.ntcf_NTMap_is_arr'[unfolded cat_op_simps]
from prems''(2) have
"η'⦇NTMap⦈⦇0⦈ =
(
σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F
𝔎23 ∙⇩N⇩T⇩C⇩F
(op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗)
)⦇NTMap⦈⦇0⦈"
by simp
from this prems 0123 have η'_NTMap_app_0: "η'⦇NTMap⦈⦇0⦈ = σ⦇NTMap⦈⦇0⦈"
by
(
cs_prems
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
cat_cs_simps
cat_op_simps
cat_Set_components(1)
cs_intro:
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_op_intros
𝔗.HomCod.cat_Hom_in_Vset
)
from prems''(2) have
"η'⦇NTMap⦈⦇1⇩ℕ⦈ =
(
σ ∘⇩N⇩T⇩C⇩F⇩-⇩C⇩F
𝔎23 ∙⇩N⇩T⇩C⇩F
(op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F ntcf_id 𝔗)
)⦇NTMap⦈⦇1⇩ℕ⦈"
by simp
from this prems 0123 have η'_NTMap_app_1: "η'⦇NTMap⦈⦇1⇩ℕ⦈ = σ⦇NTMap⦈⦇2⇩ℕ⦈"
by
(
cs_prems
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
cat_cs_simps
cat_op_simps
cat_Set_components(1)
cs_intro:
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_op_intros
𝔗.HomCod.cat_Hom_in_Vset
)+
from 0123 have 013: "[0, 1⇩ℕ]⇩∘ : 0 ↦⇘cat_ordinal (3⇩ℕ)⇙ 1⇩ℕ"
by (cs_concl cs_simp: cs_intro: cat_ordinal_cs_intros nat_omega_intros)
from 0123 have 00: "[0, 0]⇩∘ = (cat_ordinal (2⇩ℕ))⦇CId⦈⦇0⦈"
by (cs_concl cs_simp: cat_ordinal_cs_simps)
from σ.ntcf_Comp_commute[OF 013] prems 0123 013
have [cat_Kan_cs_simps]:
"σ⦇NTMap⦈⦇1⇩ℕ⦈ = η'⦇NTMap⦈⦇0⦈ ∘⇩A⇘cat_Set α⇙ 𝔉'⦇ArrMap⦈⦇0, 1⇩ℕ⦈⇩∙"
by
(
cs_prems
cs_simp:
cat_ordinal_cs_simps
cat_Kan_cs_simps
cat_cs_simps
cat_op_simps
LK23_ArrMap_app_01
cs_intro:
cat_ordinal_cs_intros
cat_Kan_cs_intros
cat_cs_intros
cat_prod_cs_intros
cat_op_intros
nat_omega_intros
cs_simp: 00 η'_NTMap_app_0[symmetric]
)
show "σ = LK_σ23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗) η' 𝔉'"
proof(rule ntcf_eqI)
show lhs: "σ :
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗 ↦⇩C⇩F 𝔉' :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α)"
by (rule prems''(1))
show rhs: "LK_σ23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗) η' 𝔉' :
op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F LK23 𝔗 ↦⇩C⇩F 𝔉' :
cat_ordinal (3⇩ℕ) ↦↦⇩C⇘α⇙ op_cat (cat_Set α)"
by
(
cs_concl
cs_simp: cat_Kan_cs_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros
)
from lhs have dom_lhs: "𝒟⇩∘ (σ⦇NTMap⦈) = 3⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
from rhs have dom_rhs:
"𝒟⇩∘ (LK_σ23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗) η' 𝔉'⦇NTMap⦈) = 3⇩ℕ"
by (cs_concl cs_simp: cat_ordinal_cs_simps cat_cs_simps)
show "σ⦇NTMap⦈ = LK_σ23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗) η' 𝔉'⦇NTMap⦈"
proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
fix c assume "c ∈⇩∘ 3⇩ℕ"
then consider ‹c = 0› | ‹c = 1⇩ℕ› | ‹c = 2⇩ℕ›
unfolding three by auto
from this 0123 show
"σ⦇NTMap⦈⦇c⦈ =
LK_σ23 (op_cf Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F 𝔗) η' 𝔉'⦇NTMap⦈⦇c⦈"
by (cases, use nothing in ‹simp_all only:›)
(
cs_concl
cs_simp:
cat_ordinal_cs_simps
cat_cs_simps
cat_Kan_cs_simps
cat_op_simps
η'_NTMap_app_0
LK_σ23_NTMap_app_0
η'_NTMap_app_1
cs_intro:
cat_ordinal_cs_intros
cat_Kan_cs_intros
cat_cs_intros
cat_op_intros
nat_omega_intros
)+
qed (cs_concl cs_simp: cs_intro: cat_Kan_cs_intros V_cs_intros)+
qed simp_all
qed
qed
then have
"op_ntcf (Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F op_ntcf (ntcf_id 𝔗)) :
op_cf (Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F op_cf 𝔗) ↦⇩C⇩F⇩.⇩l⇩K⇩e⇘α⇙
op_cf ((Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F op_cf (LK23 𝔗))) ∘⇩C⇩F op_cf (op_cf 𝔎23) :
op_cat (op_cat (cat_ordinal (2⇩ℕ))) ↦⇩C
op_cat (op_cat (cat_ordinal (3⇩ℕ))) ↦⇩C
op_cat (cat_Set α)"
by
(
cs_concl
cs_simp: cat_op_simps
cs_intro: cat_cs_intros cat_Kan_cs_intros cat_op_intros
)
from is_cat_lKe.is_cat_rKe_op[OF this] prems show
"Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F⇩-⇩N⇩T⇩C⇩F op_ntcf (ntcf_id 𝔗) :
(Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F op_cf (LK23 𝔗)) ∘⇩C⇩F op_cf 𝔎23 ↦⇩C⇩F⇩.⇩r⇩K⇩e⇘α⇙
Hom⇩O⇩.⇩C⇘α⇙𝔄(-,a) ∘⇩C⇩F op_cf 𝔗 :
op_cat (cat_ordinal (2⇩ℕ)) ↦⇩C
op_cat (cat_ordinal (3⇩ℕ)) ↦⇩C
cat_Set α"
by
(
cs_prems
cs_simp: cat_op_simps
cs_intro: cat_Kan_cs_intros cat_cs_intros cat_op_intros
)
qed
qed
qed
text‹\newpage›
end